本記事では、データ集計マクロを紹介します。商品名などが重複した行がある場合に重複行を合算して1行にまとめます。特に合算列が複数ある場合に使用できます。
このエクセル集計マクロでできること (発注データ集計、アンケート集計)
作業する対象となる表は下表になります。
A列に同じ商品名が複数ある状態です。商品名毎の合計数量を出します。手動で実施する場合の手順としては、A列の商品名でフィルターをかけて、合算してどこかに貼り付けます。今回この作業をマクロで一括で行います。
マクロの動作結果は下図のようになります。赤枠の部分が今回のマクロ実行時に追加される計算結果となります。
上の表のような発注データの集計に加え、アンケートの集計にも使用可能です。
重複行の合算マクロのコード
マクロのコードは以下の通り。
Dim sht1 As Worksheet
Sub mainfunc()
Dim ar1() As Variant 'A列の文字列をダブりなく格納した配列
Dim ar2() As Variant 'フィルタ後の行番号を格納する配列
Dim ar3() As Variant '重複を除去した項目毎に合算した値を入れた二次元配列
Dim cellRange As Range
Dim ColNum As Long
Dim Colpos As Long
Set sht1 = Sheets("集計データ")
'*************A列の値(文字列)をダブりなく配列へ格納**********
ar1 = MakeList
With sht1
'**************合算処理する範囲をマウスでドラッグして指定する
On Error Resume Next
Set cellRange = Application.InputBox("合算したい項目列の範囲をドラッグして選択してください", "合算範囲の指定", Type:=8)
If cellRange Is Nothing Then Exit Sub
ColNum = cellRange.Columns.Count
Colpos = cellRange.Column
ReDim ar3(UBound(ar1), ColNum)
For k = 0 To UBound(ar1)
'*************配列ar1の値でフィルタする
.Range("A1").AutoFilter 1, ar1(k)
'*************フィルタ後の行番号を配列ar2へ格納する
Call getFilterRow(ar2())
'**************フィルタ後の行を列ごとの合算して配列ar3へ格納する
ar3(k, 0) = .Cells(ar2(0), 1)
For ii = 0 To UBound(ar2) - 1
For i = 0 To ColNum - 1
ar3(k, 1 + i) = ar3(k, 1 + i) + .Cells(ar2(ii), Colpos + i)
Next i
Next ii
'***************１項目格納できたら、配列ar2は削除する。
ReDim ar2(0)
Next k
'**************合算結果を最終行へ貼り付ける。
Lbrow = .UsedRange.Item(.UsedRange.Count).Row
For i = 0 To UBound(ar3, 1)
For j = 0 To UBound(ar3, 2)
.Cells(Lbrow + 2 + i, j + 1) = ar3(i, j)
Next j
Next i
.Range("A1").AutoFilter
End With
End Sub
Private Function MakeList() As Variant
'*********A列の値を重複なく配列へ格納する関数********
Dim namearr() As Variant
Dim n1 As Long
With sht1
n1 = 0
i = 2 '※制限①：1行目は項目行。
Do Until IsEmpty(.Range("A" & i)) '※制限②：A列が重複を含む列とする
ReDim Preserve namearr(n1)
namearr(n1) = .Range("A" & i).Value
n1 = n1 + 1
i = i + 1
Loop
End With
'********配列をダブりが無いように編集し直す
Call DeleteSameValue(namearr)
'************配列の編集完了
MakeList = namearr
End Function
Private Sub DeleteSameValue(ar() As Variant)
'****配列内で同じ文字列を削除して、配列を小さくする関数********
Dim dic As Object
Set dic = CreateObject("scripting.dictionary") '// 重複を除いた値を格納するDictionary
Dim i '// ループカウンタ１
Dim ii '// ループカウンタ２
Dim iLen '// 配列要素数
Dim arEdit() '// 編集後の配列
ReDim arEdit(0)
iLen = UBound(ar)
'// 配列ループ
For i = 0 To iLen
'// 配列に未登録の値の場合
If (dic.Exists(ar(i)) = False) Then
'// Dictionaryに追加
Call dic.Add(ar(i), ar(i))
'// 重複がない値のみを編集後配列に格納する
arEdit(UBound(arEdit)) = ar(i)
ReDim Preserve arEdit(UBound(arEdit) + 1)
End If
Next
'// 配列に格納済みの場合
If (IsEmpty(arEdit(0)) = False) Then
'// 余分な領域を削除
ReDim Preserve arEdit(UBound(arEdit) - 1)
End If
'// 引数に編集後配列を設定
ar = arEdit
End Sub
Sub getFilterRow(ar() As Variant)
'*********フィルター後の行番号を取得する関数***********
ReDim ar(0)
r = 2
With sht1
Do While .Cells(r, 1) <> ""
If .Cells(r, 1).EntireRow.Hidden = False Then
ReDim Preserve ar(UBound(ar) + 1)
ar(UBound(ar) - 1) = r
End If
r = r + 1
Loop
End With
End Sub
次の①～⑦でコードの詳細について説明していきます。
①商品名を重複なく、配列ar1へ格納(重複なく配列へ格納する関数の作成)。
ここでは、コードが長くなってしまう為、関数を作成していきます。
Private Function MakeList() As Variant
'*********A列の値を重複なく配列へ格納する関数********
Dim namearr() As Variant
Dim n1 As Long
With sht1
n1 = 0
i = 2 '※制限①：1行目は項目行。
Do Until IsEmpty(.Range("A" & i)) '※制限②：A列が重複を含む列とする
ReDim Preserve namearr(n1)
namearr(n1) = .Range("A" & i).Value
n1 = n1 + 1
i = i + 1
Loop
End With
'********配列をダブりが無いように編集し直す
Call DeleteSameValue(namearr)
'************配列の編集完了
MakeList = namearr
End Function
'※ここまでがMakelistという関数。
Private Sub DeleteSameValue(ar() As Variant)
'****配列内で同じ文字列を削除して、配列を小さくする関数********
Dim dic As Object
Set dic = CreateObject("scripting.dictionary") '// 重複を除いた値を格納するDictionary
Dim i '// ループカウンタ１
Dim ii '// ループカウンタ２
Dim iLen '// 配列要素数
Dim arEdit() '// 編集後の配列
ReDim arEdit(0)
iLen = UBound(ar)
'// 配列ループ
For i = 0 To iLen
'// 配列に未登録の値の場合
If (dic.Exists(ar(i)) = False) Then
'// Dictionaryに追加
Call dic.Add(ar(i), ar(i))
'// 重複がない値のみを編集後配列に格納する
arEdit(UBound(arEdit)) = ar(i)
ReDim Preserve arEdit(UBound(arEdit) + 1)
End If
Next
'// 配列に格納済みの場合
If (IsEmpty(arEdit(0)) = False) Then
'// 余分な領域を削除
ReDim Preserve arEdit(UBound(arEdit) - 1)
End If
'// 引数に編集後配列を設定
ar = arEdit
End Sub
一旦、A列の値をすべて配列へ格納した後、配列内の重複を削除して配列を小さくします。下記サイトを参考に配列の重複を削除する関数を作成しました。
動的配列を大きくしながら、値を格納していく方法については、以下の記事に記載しています。
これでar1内へ重複なく要素を格納できました。
②合算処理する列をマウスで指定させる。
今回は合算する列を手動で複数行指定します。複数行指定は可能ですが、連続している列だけが対象になります(飛び飛びの列を指定することはできません。)
また、指定するのは合算する”列”が全て含まれていればよく、行を全て指定する必要はありません。
'**************合算処理する範囲をマウスでドラッグして指定する
On Error Resume Next
Set cellRange = Application.InputBox("合算したい項目列の範囲をドラッグして選択してください", "合算範囲の指定", Type:=8)
If cellRange Is Nothing Then Exit Sub
③重複のある列にフィルターをかける。
①で作成したar1配列に従って順にフィルターをかけていきます。(Autofilterでかけていきます。)
'*************配列ar1の値でフィルタする
.Range("A1").AutoFilter 1, ar1(k)④フィルター後の行番号を配列ar2へ格納(フィルター後の行番号を取得する関数)。
フィルターした後、合算列の値を後で参照するので、フィルター後の行番号を配列ar2へ格納します。
ここでもコードをすっきりさせるため、関数として処理します。getFilterRowという関数を作成しました。
Sub getFilterRow(ar() As Variant)
'*********フィルター後の行番号を取得する関数***********
ReDim ar(0)
r = 2
With sht1
Do While .Cells(r, 1) <> ""
If .Cells(r, 1).EntireRow.Hidden = False Then
ReDim Preserve ar(UBound(ar) + 1)
ar(UBound(ar) - 1) = r
End If
r = r + 1
Loop
End With
End Sub以下のサイトを参考に作成しています。
⑤フィルター後の商品名と、各列の値（依頼数量）の合算値を配列ar3へ格納。
合算すべき行番号が分かったので、この行番号で指定して、各列の値を拾ってゆき、合計値を配列へ格納します。
'**************フィルタ後の行を列ごとの合算して配列ar3へ格納する
ar3(k, 0) = .Cells(ar2(0), 1)
For ii = 0 To UBound(ar2) - 1
For i = 0 To ColNum - 1
ar3(k, 1 + i) = ar3(k, 1 + i) + .Cells(ar2(ii), Colpos + i)
Next i
Next ii⑥格納したar3を適当な箇所へ入力する。
二次元配列ar3が求める結果になります。今回、結果は同じシートの最下行に入力しています。
'**************合算結果を最終行へ貼り付ける。
Lbrow = .UsedRange.Item(.UsedRange.Count).Row
For i = 0 To UBound(ar3, 1)
For j = 0 To UBound(ar3, 2)
.Cells(Lbrow + 2 + i, j + 1) = ar3(i, j)
Next j
Next i⑦フィルターを戻す。
データを取得した際にフィルターをかけているので、最後に元に戻しておきます。
.Range("A1").AutoFilterまとめとエクセルVBAファイルのダウンロード
今回は重複行を合算集計するマクロの複数行版を作成しました。商品受注、発注数量管理やアンケートの集計などで、少しシートが複雑になってしまったリストの集計に使用可能かと思います。
操作説明とマクロの起動ボタンのシートも追加しています。
合算したデータを集計データへ貼り付けてボタンを押します。
集計したいデータ列をマウスでドラッグして決定。
すると一瞬で集計が完了します。
ファイルのダウンロードはこちらから。
シート同士で各行を比較するマクロ↓
コメントを入力