ここから本文です

VBAで小計・合計金額を出したいのですが・・・ 画像の左側にあるシートを作ったの...

kaz********さん

2018/6/611:14:54

VBAで小計・合計金額を出したいのですが・・・
画像の左側にあるシートを作ったのですが、購入場所ごとの括りで、
購入場所Aと購入場所Bの間に2行空白行があります。

今回VBAで画像の右側にある緑色のセル部分(実際はセルの色は変えません。)を出したいのですが、

例えば、購入場所A の場合、
F列に個数×単価で合計金額と、空白行2行(15,16行目)のうち、1行目の15行目に【購入場所A ・小計】と入れて、交通費の合計と商品の合計金額を出して、

以下、同様に購入場所ごとに同じ処理をして、最終的にC2のセルに商品購入の合計金額と、C3のセルに交通費の合計金額を表示させたいのですが、全てをVBAで表示させることはできるのでしょうか。

VBA勉強を始めたばかりなのですが、この処理が必要になって困っています。

宜しくお願いします。

B&quot,合計金額,小計,VBA,セル,F&quot,r.Count

閲覧数:
178
回答数:
3
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

msk********さん

2018/6/615:18:31

一例です。

Sub sample()
Dim r As Range, i As Long
Range("C2").Resize(2).ClearContents
With Range("b10", Cells(Rows.Count, "B").End(xlUp))
For Each r In .SpecialCells(xlCellTypeConstants).Areas
r(r.Count + 1) = r(1) & "・小計"
For i = 2 To r.Count
r(i, 5) = r(i, 3) * r(i, 4)
Next
r(r.Count + 1, 2) = Application.Sum(r.Offset(, 1))
r(r.Count + 1, 5) = Application.Sum(r.Offset(, 4))
Range("C3") = Range("C3") + r(r.Count + 1, 2)
Range("C2") = Range("C2") + r(r.Count + 1, 5)
Next
End With
End Sub

質問した人からのコメント

2018/6/7 14:24:06

ありがとうございました。

早速 使わせていただきました。そして、勉強になりました。
ただ、まだVBAの勉強を始めたばかりで、全てを理解するまでには
なっていませんが、今回教えていただいた事を参考に勉強していきたいと
思います。

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

db1********さん

2018/6/710:35:28

案です。

実際のイメージには近いと思いますが、その分コードはスマートではありません。

(1)1行ごとに判定していく方法と(2)CTRL+↓のカーソル移動での方法です。

(1)
Sub 小計を求める()
' 「マクロで小計・合計を求める」シート
Dim gyou As Long
Dim i As Long
Dim b, c, d, e
Dim raberu As String
Dim kei1, keia '交通費=kei1、累計=keia
Dim kei2, keib '合計=kei2、合計の累計=keib


gyou = Range("b" & Rows.Count).End(xlUp).Row

' 初期処理~挿入する小計行をクリアする。
For i = 10 To gyou
If Mid(Range("b" & i), 1, 1) = "【" And Right(Range("b" & i), 1) = "計" Then
Range("b" & i) = ""
End If
Next

For gyou = 10 To gyou + 1
b = Range("b" & gyou).Value
c = Range("c" & gyou).Value
d = Range("d" & gyou).Value
e = Range("e" & gyou).Value

If Mid(b, 1, 1) = "【" And Right(b, 1) <> "計" Then
raberu = b & ".小計"

ElseIf b = "" And Mid(Range("b" & gyou - 1), 1, 1) <> "【" And Range("b" & gyou + 1) = "" Then
Range("b" & gyou) = raberu
Range("c" & gyou) = kei1
Range("f" & gyou) = kei2
keia = keia + kei1
keib = keib + kei2
kei1 = 0
kei2 = 0

ElseIf Mid(b, 1, 1) <> "【" And b <> "" Then
kei1 = kei1 + c
kei2 = kei2 + d * e
Else
'
End If
Next

Range("c2") = keib
Range("c3") = keia

End Sub

(2)
Sub 小計の追加_カーソル移動()
' カーソル移動で小計を追加する。
Dim cel1
Dim cel2
Dim i, j, gyou

gyou = Range("b" & Rows.Count).End(xlUp).Row
' 初期処理~挿入する小計行をクリアする。
For i = 10 To gyou
If Mid(Range("b" & i), 1, 1) = "【" And Right(Range("b" & i), 1) = "計" Then
Range(Cells(i, "b"), Cells(i, "f")) = ""
End If
Next
Range("c2:c3").ClearContents

'Subtotal()関数を利用。
Range("c2") = "=subtotal(9,f11:f" & gyou & ")"
Range("c3") = "=subtotal(9,c11:c" & gyou & ")"

'合計列に計算式を代入します。
i = 10
Range("f10") = "=IF(OR(B10="""",E10=""""),"""",D10*E10)"
Range("f10").Copy
Range("f11:f" & gyou).PasteSpecial (xlPasteFormulas)
Application.CutCopyMode = False

'小計は、Subtaotal関数として代入。
Do While i <= gyou
cel1 = i + 1
j = Range("b" & i).End(xlDown).Row
cel2 = j
Range("b" & j + 1) = Range("b" & i) & ".小計"
Range("c" & j + 1) = "=subtotal(9,c" & cel1 & ":c" & cel2 & ")"
Range("f" & j + 1) = "=subtotal(9,f" & cel1 & ":f" & cel2 & ")"

j = Range("b" & j + 1).End(xlDown).Row
i = j
Loop

Range("c2").Select

End Sub

tac********さん

2018/6/611:35:45

>VBA勉強を始めたばかりなのですが、この処理が必要になって困っています。

学校の宿題ですか?

アイディアだけの紹介です。

・シートの変更イベントでセルが該当するセルか調べ、計算し結果をセルへ登録。

・自前の関数を作り、その関数をセルに登録する。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

あわせて知りたい

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる