重複している項目別に集計／ディクショナリ
＊事前設定）参照設定を行う
VBA画面のツールメニュー→参照設定を選び、参照設定ダイアログで「Microsoft Scripting
Runtime」にチェックを付ける
Sub ディクショナリ_重複チェック()
Dim i As Long
Dim j As Long
Dim maxRow As Long
Dim dic As Dictionary
Dim strMat, lngNum
Set dic = New Dictionary
j = 2 'リスト書き出し開始行
With ActiveSheet
maxRow = .Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To maxRow
strMat = .Cells(i, 2).Value
lngNum = .Cells(i, 3).Value
If dic.Exists(strMat) Then
.Cells(dic.Item(strMat), 7).Value = .Cells(dic.Item(strMat), 7).Value + lngNum
Else
dic.Add (.Cells(i, 2).Value), j
.Cells(j, 6).Value = strMat
.Cells(j, 7).Value = lngNum
j = j + 1
End If
Next i
End With
MsgBox "完了"
End Sub解説
上記のコードは、ディクショナリを使用して重複するキーの存在をチェックし、重複しない場合にリストを書き出すものです。
ディクショナリに追加されるキーは、i行目の2列目の値で、重複がある場合は、すでに追加されているキーの行番号を取得し、その行の7列目の値にlngNumを加算します。重複がない場合は、キーをディクショナリに追加し、j行目にstrMatとlngNumを書き込みます。その後、jを1つ増やして、次の行に移動します。
ディクショナリ Part2
これは、データを含むエクセルシートの重複をチェックするために、VBAの辞書オブジェクトを使用して、各行を処理するエクセルマクロです。
Sub ディクショナリ_重複チェック()
Dim i As Long
Dim j As Long
Dim maxRow As Long
Dim dic As Dictionary
Dim strMat, lngNum
Set dic = New Dictionary
j = 1 'リスト書き出し開始行を1に変更
With ActiveSheet
maxRow = .Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To maxRow
strMat = .Cells(i, 2).Value
lngNum = .Cells(i, 3).Value
If dic.Exists(strMat) Then
row = dic.Item(strMat) 'すでに追加された行番号を取得
.Cells(row, 7).Value = .Cells(row, 7).Value + lngNum
Else
dic.Add strMat, j 'キーをディクショナリに追加
.Cells(j, 6).Value = strMat
.Cells(j, 7).Value = lngNum
j = j + 1
End If
Next i
End With
MsgBox "完了"
End Sub説明
- 1行目で、必要な変数を宣言しています。i, j, maxRow, dic, strMat, lngNumの6つの変数が定義されています。
- 5行目で、リスト書き出し開始行を1に設定しています。この値は、リストの最初の行がどこにあるかを示しています。
- 7-16行目では、ActiveSheetオブジェクトを使用してアクティブなシートを参照し、処理のために必要なデータを取得しています。maxRow変数には、シートのB列にある最終行番号が代入されます。Forループの中で、2からmaxRowまでの範囲で、各行の2列目の値（strMat）と3列目の値（lngNum）を取得しています。
- 18-25行目では、辞書オブジェクトを使用して、各行の2列目の値が重複しているかどうかを確認しています。Existsメソッドを使用して、指定されたキー（strMat）が辞書に存在するかどうかを確認し、存在する場合は、そのキーに関連付けられた値（すでに追加された行番号）を取得して、その行の7列目の値に、3列目の値（lngNum）を加算します。存在しない場合は、Addメソッドを使用して、新しいキー（strMat）と行番号（j）を辞書に追加します。そして、その行に2列目の値（strMat）を、7列目の値（lngNum）を記入します。そして、jを1増やして、次の行の書き込み位置を更新します。
- 最後に、29行目で、「完了」というメッセージを表示するダイアログボックスを表示して、処理を終了します。
コメント