VBAのマクロで、複数行を1行に集計

質問

お世話になります。VBA初心者です。
下記のような表があった場合、請求書番号が同じものをVBAで1行に集計するにはどうしたらよろしいのでしょうか？
請求書No.|顧客名|摘要|金額
111111　 |鈴木 | A |100
111111 |鈴木 | S |160
222222 |佐藤 | F |500
555555 |山田 | A |150
555555 |山田 | D |200
888888 |鈴木 | S |160
　↓下記のように集計
請求書No.|顧客名|摘要|金額
111111 |鈴木 | A |260
222222 |佐藤 | F |500
555555 |山田 | A |350
888888 |鈴木 | S |160
摘要は各請求書番号の最初の行を使います。重複は2行とは限りません。また、最終的に何枚の請求書があるのかも計算させたいのです。ただしこれはどこかに関数"=counta()"を使えばVBAでなくても出来るのですが。
よろしくお願いいたします。

回答No.5

Wendy02 · ベストアンサー

#4の回答者です。

>請求書No.はA列には無くまだ確定では何いのですがH列以降になる予定です。
それは、

Set myData = sh1.Range("A1").CurrentRegion
ここで決めていきます。CurrentRegion ですと、地続きの範囲ということになって、A列から含まれてしまいますので、

Set myData = sh1.Range("H1", sh1.Range("H65536").End(xlUp).Offset( ,4))

というスタイルになります。 Offset( ,4) というのは、H列を含めて右へ4列　という範囲を示します。
sh1.Range("H65536").End(xlUp)　というのは、H列の一番下のデータという意味です。

しかし、統合することは可能でも、出力のレイアウト自体が決まっていかないと、今のコードから、そんなに簡単に直せるとは言いにくいですね。

>金額はH列より後の列に入ります(予定ではI列)。

H列を基準に統合すると、現在のマクロですと、その隣の列に、集計の金額が出てきてしまいます。

また、数式は、以下の部分を直せばよいのですが……。

> sh2.Range(.Cells(2, 2), .Cells(.Rows.Count, 3)).FormulaLocal = _
>　　 "=VLOOKUP($A2," & sh1.Name & "!" & myData.Address(1, 1) & ",COLUMN(B1),0)"
>　　.Value = .Value

=VLOOKUP($A2,Sheet1!$H$1:$K$7,COLUMN(C1),0)

例えば、こんな風にするには、

　sh2.Range(.Cells(2, 3), .Cells(.Rows.Count, 4)).FormulaLocal = _
　　 "=VLOOKUP($A2," & sh1.Name & "!" & myData.Address(1, 1) & ",COLUMN(C1),0)"
　　.Value = .Value

となります。

それを自由に出力列を変更できるようにするには、全面的にマクロコードを変更しなくてはならないような気がします。

今の段階では、例えば、こういうスタイルなら、

請求書No.　　金額　　顧客名　　摘要

こういうスタイルで出てきてしまうことになってしまいます。

お礼

いつも本当にありがとうございます。
細かい丁寧な説明なので本当に助かっております。
結局、請求書番号をA列に持ってきて、集計をした後に前回教わったマクロを使い、さらに新しいシートに並べ替えることにしました。
今後ともよろしくお願いいたします。

回答No.4

Wendy02

こんばんは。

例えば、集計をSheet2 に出すように作ってみました。
これは、フィルタオプションと統合を組み合わせれば簡単に出来ます。
他の方法もありますが、記録マクロの延長の方法です。ただ、空白部分の補完の方法などは、多少の技術は必要になってきます。

'標準モジュール

Sub Test1()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim myData As Range
Dim tmpData As Range
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")

Set myData = sh1.Range("A1").CurrentRegion

'出力する場所を削除しておく
sh2.Range("A1").CurrentRegion.ClearContents

'フィルタオプションで、1列目のユニーク番号を取り出す
　　myData.Columns(1).AdvancedFilter _
　　Action:=xlFilterCopy, _
　　CopyToRange:=sh1.Range("AA1"), _
　　Unique:=True
'出力場所
Set tmpData = sh1.Range("AA1").CurrentRegion

'統合
sh2.Range("A1").Consolidate _
　　　　Array(sh1.Name & "!" & myData.Address(1, 1, xlR1C1), _
　　　　sh1.Name & "!" & tmpData.Address(1, 1, xlR1C1)), _
　　　　xlSum, False, True, False

'VLOOKUPで、データの補完
　myData.Rows(1).Copy sh2.Range("A1")
　With sh2.Range("A2").CurrentRegion
　 sh2.Range(.Cells(2, 2), .Cells(.Rows.Count, 3)).FormulaLocal = _
　　 "=VLOOKUP($A2," & sh1.Name & "!" & myData.Address(1, 1) & ",COLUMN(B1),0)"
　　.Value = .Value
'件数の出力
　　.Cells(1, .Columns.Count + 1).Value = "=""件数：""&COUNT(" & .Columns(4).Address(0, 0) & ")"
　End With
　tmpData.ClearContents
　Set myData = Nothing
　Set tmpData = Nothing
　Set sh1 = Nothing
　Set sh2 = Nothing
End Sub

補足

実は例としてあげたものと実際のものとでは少し違いがありまして、請求書No.はA列には無くまだ確定では何いのですがH列以降になる予定です。A～Gまでにはその他の数値・記述(日付やメモ書き)が入り、集計したい金額はH列より後の列に入ります(予定ではI列)。
このような場合はどこをどう変えればよろしいのでしょうか？
毎回すみませんが、よろしくお願いいたします。

回答No.3

imogasi

VBAで
（１）WorkSheetFunction.SUMIFを使う
（２）総なめで１１１１１（など）を探して足しこむ
（３）請求書NOでソートして、並びがブレークするまで足しこむ
（４）Find、FindNextで１１１１１１（など）を探して足しこむ。
人間が電卓で目で見て足す場合はこれでしょう。
などあるが（１）、（２）、（４）は請求書Noのユニークな（重複の無い）一覧がシート上に無いと、出てきた都度集計していると複数回同じこと（１１１１１１を集計）をしてしまう。
結局（２）が優れていると思う。ただデータ順序を崩すたくない場合は、作業シートにコピーしてそちらでやるか、初めに連番を振っておき、当初の並ぶ順にソートで戻す必要があるが。
（３）のロジックは、前行の請求書番号を変数に記録し、常に前行と現在行を比較し、
・変わらない同じとき、合計変数に足しこみーー＞次行へ
・変わったとき、前の行のA-C列を書き出しセルに代入（A)
　　　　　　　合計の書き出し（B)
　　　　　　　書き出し行を＋１（下行を指す）
　　　　　　　合計に現在行の計数足しこみ（０にして現在行の計数足しこみ）
　　　　　　　前行変数に現在行データを書く
　　　　　　　－－＞次行へ
終わり行の後だけ、特別に（A)（B)を行う。
上記の意味が読んでわかったらすごいが。

お礼

早速のご回答に感謝いたします。
おっしゃるとおり私にはもう少し勉強が必要なようです。
現在の私には難しすぎますので、知識がつきましたら再度読み返させていただきます。
ありがとうございました。

回答No.2

Golmore

「ツール」→「統合」機能を使う方法もあります。
例）元データがA列～D列に記述されていると過程して、VBAで書くとこんな感じになります。
Range("F1").Consolidate Sources:="C1:C4", Function:=xlSum, LeftColumn:=True
の１行を実行しただけで、請求番号ごとに集計された結果が、F列～I列
に出力されます。
※顧客名・摘要列は無視されるので、G～H列は空白列になります。
あとは、CountIfで個数・VLookupで顧客名引っ張ってくればおおよそ
完成ですね。マクロでセル内に関数を書くのでもいいですし。

お礼

まず、びっくりしております。
まさにやりたいことが、こんなにシンプルに出来るとは思っても降りませんでした。サンプルデータで試してみましたが、本当にびっくりしました。
ただし、コラムが上記のサンプルと違い必要なデータがA列から4つ綺麗に並んでおりません。また、これ以外のマクロも色々と組んでおり、すこしフォーマットも考え直さないといけません。
現状ではこのまま使わせていただくことは出来ないのですが、このシンプルさはとても魅力に思っております。私はド素人なのでゴチャゴチャとくっつけては切捨ての繰り返しのためとても複雑なものを作りがちです。とっても参考になりました。本当にありがとうございました。

回答No.1

kuma3f

思われていることと違っていましたらすみませんが参考までに試してみてください。
Ａｌｔキー押しながらＦ８キーを押します。
　↓
マクロのダイアログが表示されたらマクロ名に自由に名前を入力してください。（例：集計）
　↓
名前を入力しましたら、「作成」をクリック
　↓
Microsoft Visual Basicの画面が開きますのでSub 集計()の下に次のコードをコピーして貼り付けてください。

Dim シート1カウント, 集計シートカウント, シート1件数, 金額, スイッチ As Long
Dim シート名, 請求NO, 顧客名, 摘要 As String
シート名 = ActiveSheet.Name
スイッチ = 0
On Error GoTo skip1
Sheets("集計シート").Select
スイッチ = 1
skip1:
If スイッチ = 0 Then '集計シートが無かったら作成する
Sheets.Add
ActiveWorkbook.ActiveSheet.Name = "集計シート"
End If
Sheets("集計シート").Cells.ClearContents
'集計
Sheets(シート名).Select
シート1件数 = Application.WorksheetFunction.CountA(Worksheets(シート名).Range("A1:A65536"))
シート1カウント = 1
集計シートカウント = 1
請求NO = Sheets(シート名).Cells(シート1カウント, 1)
顧客名 = Sheets(シート名).Cells(シート1カウント, 2)
摘要 = Sheets(シート名).Cells(シート1カウント, 3)
金額 = Sheets(シート名).Cells(シート1カウント, 4)
シート1カウント = シート1カウント + 1
Do
If 請求NO = Sheets(シート名).Cells(シート1カウント, 1) Then
金額 = 金額 + Sheets(シート名).Cells(シート1カウント, 4)
Else
Sheets("集計シート").Cells(集計シートカウント, 1) = 請求NO
Sheets("集計シート").Cells(集計シートカウント, 2) = 顧客名
Sheets("集計シート").Cells(集計シートカウント, 3) = 摘要
Sheets("集計シート").Cells(集計シートカウント, 4) = 金額
集計シートカウント = 集計シートカウント + 1
請求NO = Sheets(シート名).Cells(シート1カウント, 1)
顧客名 = Sheets(シート名).Cells(シート1カウント, 2)
摘要 = Sheets(シート名).Cells(シート1カウント, 3)
金額 = Sheets(シート名).Cells(シート1カウント, 4)
End If
シート1カウント = シート1カウント + 1
Loop Until シート1カウント > シート1件数
Sheets("集計シート").Cells(集計シートカウント, 1) = 請求NO
Sheets("集計シート").Cells(集計シートカウント, 2) = 顧客名
Sheets("集計シート").Cells(集計シートカウント, 3) = 摘要
Sheets("集計シート").Cells(集計シートカウント, 4) = 金額
集計シートカウント = 集計シートカウント + 1
Sheets("集計シート").Cells(集計シートカウント, 2) = "請求書枚数 = " & 集計シートカウント - 2 & "枚"
Sheets("集計シート").Select
MsgBox "集計しました。　請求書枚数 = " & 集計シートカウント - 2 & "枚です。"

'****コピー貼り付けはここまで ****

Microsoft Visual Basicの画面を×で閉じます。
使い方は、Ａｌｔキー押しながらＦ８キーを押します。
マクロのダイアログが表示されるので先ほど名前を付けたマクロを選択して「実行」をクリック。
（選択されている状態でしたら、そのままＥｎｔｅｒキーで実行されます。）
集計シートに結果が集計されていると思います。

お礼

>思われていることと違っていましたら…
まさにこれがやりたかったことです。ありがとうございました。
色々な方法があるのですね、丁寧な補足説明付ですので色々とアレンジが出来そうです。
また、それぞれのマクロも他で流用できそうなものがございますので、ぜひ使わせていただきます。
本当にありがとうございました。