データの集計についてVBAマクロを組んでください。

質問

下記のようにA列に金額　Ｂ列に欄No.があります。VBAマクロで集計した結果を出すマクロの記述の仕方を教えてください。
金額　　欄No.
232 　　　 1
1005 　　 1
812 　　　 2
425 　　　 2
193 　　　　1

回答No.7

High_Score

どこかのセルに
=sumif(B1:B5,1,A1:A5) 1の合計
=sumif(B1:B5,2,A1:A5) 2の合計

これだけです。

マクロの文法やら実行方法やら覚えるよりずっと楽で応用も利きます。マクロは毎回毎回同じ操作を延々続ける人にとっては手間を省いてもらえますが、マクロを書くのは面倒です。一回ポッキリの使用には適しません。

お礼

SUMIF関数についてもう少し勉強します。ご対応ありがとうございました。

回答No.6

tom04

続けてお邪魔します。

一度回答をアップしたはずなのですが、ちゃんと投稿できていないようなので、
もう一度回答してみます。
もし、ダブっていたらごめんなさい。

＞できればコメントを書いていただければ助かります。

同列に表示させたいというコトですので、データ変更があっても対応できるようにすると
あのような感じになってしまいました。
1度だけの操作であれば集計させたセルを消去する必要がないので、もっと簡単になります。

今回はやはりデータ変更があっても対応できるようにしてみました。
コメントもダラダラと記載しています。

Sub Sample4()
Dim i As Long, c As Range, lastRow1 As Long, lastRow2 As Long
Dim myRng1 As Range, myRng2 As Range

Set c = Range("A:A").Find(what:="欄No", LookIn:=xlValues, lookat:=xlWhole) '★A列で「欄No」のセルを検索
If c Is Nothing Then '★A列に「欄No」のセルがない場合
lastRow1 = Cells(Rows.Count, "A").End(xlUp).Row '★lastRow1はA列最終行
Else '★ある場合
lastRow1 = c.Row - 1 '★「lastRow1」は「欄No」セルの1行上の行番号（画像では「6」）
lastRow2 = Cells(Rows.Count, "A").End(xlUp).Row '★lastRow2はA列最終行
Range(Cells(lastRow1 + 1, "A"), Cells(lastRow2, "B")).ClearContents '★「欄No」セル以降B列最終行までのデータを消去
End If
Set myRng1 = Range(Cells(1, "A"), Cells(lastRow1, "A")) '★myRng1にA1～A列最終行までを格納
Set myRng2 = Range(Cells(1, "B"), Cells(lastRow1, "B")) '★myRng2にB1～B列最終行までを格納
'★　myRng2範囲をフィルタを掛け、重複なしにA列最終行の1行下にに貼り付け
myRng2.AdvancedFilter Action:=xlFilterCopy, copytorange:=Cells(lastRow1 + 1, "A"), unique:=True
lastRow2 = Cells(Rows.Count, "A").End(xlUp).Row '★lastRow2は貼り付けセルを含むA列最終行
'★　A列に貼り付けたセルを昇順に並び替え
Range(Cells(lastRow1 + 1, "A"), Cells(lastRow2, "A")).Sort key1:=Cells(lastRow1, "A"), order1:=xlAscending, Header:=xlYes
Cells(lastRow1 + 1, "B") = "合計金額" '★B列最終行の1行下に「合計金額」と表示
For i = lastRow1 + 2 To lastRow2 '★「i」は追加項目行の1行下から最終行までループ
Cells(i, "B") = WorksheetFunction.SumIf(myRng2, Cells(i, "A"), myRng1) '★　i行B列はSUMIF関数で結果表示
Next i
End Sub

※　↓の画像を参考にコードを照らし合わせてみてください。m(_ _)m

お礼

返事が遅くなってすいません。コメントの件ありがとうございました。大変助かりました。

回答No.5

tom04

続けてお邪魔します。

＞できればコメントを書いていただければ助かります。

同列に表示させたいというコトですので、データ変更があっても対応できるようにすると
あのような感じになってしまいました。
1度だけの操作であれば集計させたセルを消去する必要がないので、もっと簡単になります。

今回はやはりデータ変更があっても対応できるようにしてみました。
コメントもダラダラと記載しています。

Sub Sample4()
Dim i As Long, c As Range, lastRow1 As Long, lastRow2 As Long
Dim myRng1 As Range, myRng2 As Range

Set c = Range("A:A").Find(what:="欄No", LookIn:=xlValues, lookat:=xlWhole) '★A列で「欄No」のセルを検索
If c Is Nothing Then '★A列に「欄No」のセルがない場合
lastRow1 = Cells(Rows.Count, "A").End(xlUp).Row '★lastRow1はA列最終行
Else '★ある場合
lastRow1 = c.Row - 1 '★「lastRow1」は「欄No」セルの1行上の行番号（画像では「6」）
lastRow2 = Cells(Rows.Count, "A").End(xlUp).Row '★lastRow2はA列最終行
Range(Cells(lastRow1 + 1, "A"), Cells(lastRow2, "B")).ClearContents '★「欄No」セル以降B列最終行までのデータを消去
End If
Set myRng1 = Range(Cells(1, "A"), Cells(lastRow1, "A")) '★myRng1にA1～A列最終行までを格納
Set myRng2 = Range(Cells(1, "B"), Cells(lastRow1, "B")) '★myRng2にB1～B列最終行までを格納
'★　myRng2範囲をフィルタを掛け、重複なしにA列最終行の1行下にに貼り付け
myRng2.AdvancedFilter Action:=xlFilterCopy, copytorange:=Cells(lastRow1 + 1, "A"), unique:=True
lastRow2 = Cells(Rows.Count, "A").End(xlUp).Row '★lastRow2は貼り付けセルを含むA列最終行
'★　A列に貼り付けたセルを昇順に並び替え
Range(Cells(lastRow1 + 1, "A"), Cells(lastRow2, "A")).Sort key1:=Cells(lastRow1, "A"), order1:=xlAscending, Header:=xlYes
Cells(lastRow1 + 1, "B") = "合計金額" '★B列最終行の1行下に「合計金額」と表示
For i = lastRow1 + 2 To lastRow2 '★「i」は追加項目行の1行下から最終行までループ
Cells(i, "B") = WorksheetFunction.SumIf(myRng2, Cells(i, "A"), myRng1) '★　i行B列はSUMIF関数で結果表示
Next i
End Sub

※　↓の画像を参考にコードを照らし合わせてみてください。m(_ _)m

回答No.4

tom04

No.2の補足
＞ちなみに集計結果をA列とB列の下に記述する場合はどのようなマクロを組めばいいか教えてください。
の件について・・・

Sub Sample3()
Dim i As Long, lastRow As Long, lastRow2 As Long
Dim myRngA As Range, myRngB As Range
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = lastRow To 2 Step -1
If Cells(i, "A") = "欄No" Then
lastRow2 = i
Exit For
End If
Next i
If lastRow2 > 1 Then
Range(Cells(i, "A"), Cells(lastRow, "B")).ClearContents
lastRow = i - 1
Else
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
End If
Set myRngA = Range(Cells(1, "A"), Cells(lastRow, "A"))
Set myRngB = Range(Cells(1, "B"), Cells(lastRow, "B"))
Cells(lastRow + 1, "A").Value = Range("B1")
myRngB.AdvancedFilter Action:=xlFilterCopy, copytorange:=Cells(lastRow + 1, "A"), unique:=True
Cells(lastRow + 1, "B") = "合計金額"
lastRow2 = Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(lastRow + 1, "A"), Cells(lastRow2, "A")).Sort key1:=Cells(lastRow + 1, "A"), order1:= _
xlAscending, Header:=xlYes
For i = lastRow + 2 To lastRow2
Cells(i, "B") = WorksheetFunction.SumIf(myRngB, Cells(i, "A"), myRngA)
Next i
End Sub

※　本来であれば別列に集計データを表示させた方が判りやすいと思います。m(_ _)m

補足

う～ん、なかなか難しいですね。できればコメントを書いていただければ助かります。

回答No.3

tom04

No.2です。

＞こちらの希望としては同一シートで集計したいです。結果は列Cと列Dに表示させたいです
というコトですので、もっと簡単になります。

Sheetモジュールにしてください。
画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面のカーソルが点滅しているところに
↓のコードにコピー＆ペースト　→　Excel画面に戻りマクロ実行です。

Sub Sample2()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
If lastRow > 1 Then
Range(Cells(2, "C"), Cells(lastRow, "D")).ClearContents
End If
Range("B:B").AdvancedFilter Action:=xlFilterCopy, copytorange:=Range("C1"), unique:=True
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
Range(Cells(1, "C"), Cells(lastRow, "C")).Sort key1:=Range("C1"), order1:=xlAscending, Header:=xlYes
With Range(Cells(2, "D"), Cells(lastRow, "D"))
.Formula = "=SUMIF(B:B,C2,A:A)"
.Value = .Value
End With
End Sub

これで↓の画像のような感じになります。m(_ _)m

補足

なるほど集計結果がC列とD列に張り付きました。ちなみに集計結果をA列とB列の下に記述する場合はどのようなマクロを組めばいいか教えてください。

回答No.2

tom04

こんばんは！

No.1さんの補足に
＞範囲は記述されている最終行までです。
とありますが、SUMIF関数そのものは列すべてを選択してもそんなに負担を掛ける関数ではありませんので、
「最終行」は気にしなくて良いと思います。

関数でやった方が簡単なようですが、VBAをご希望というコトなので一例です。
↓の画像のように左側がSheet1で右側のSheet2に表示するとします。

標準モジュールに↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet1")
With Worksheets("Sheet2")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow, "B")).ClearContents
End If
wS.Range("B:B").AdvancedFilter Action:=xlFilterCopy, copytorange:=.Range("A1"), unique:=True
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Range(.Cells(1, "A"), .Cells(lastRow, "A")).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes
With Range(.Cells(2, "B"), .Cells(lastRow, "B"))
.Formula = "=SUMIF(Sheet1!B:B,A2,Sheet1!A:A)"
.Value = .Value
End With
End With
End Sub

※　コードはループさせずに、そのままワークシート関数を使用していますが、
もちろんSheet2のA列2行目からループさせて
wS2.cells(i,"B")=WorksheetFunction.SumIf("範囲","検索条件","合計範囲")
というような感じでも構いません。m(_ _)m

補足

なるほど。この例は別シートですが、こちらの希望としては同一シートで集計したいです。結果は列Cと列Dに表示させたいです。

回答No.1

noname#200078

列の最後が増えてゆくことがあるのかどうかとか、欄No.がどう関わってくるのかわかりませんが、SUMIFなら
Application.WorkSheetFunction.ワークシート関数のSUMIF
がわかりやすいとおもうのですが。

補足

説明不足でした。欄ごとの合計金額を別のセルに表示させたいです。範囲は記述されている最終行までです。SUMIFのやり方がイマイチわからないのでこのマクロを記述していただければ大変助かります。