皆様こんにちは、ノグチです。
前回までの複数の記事で、複数のループを使って処理していたリストの重複排除を、下記3ステップでDictionaryオブジェクトを使ったコードに置き換えていく方法をご紹介してきました。
- Dictionaryオブジェクトにキーと要素を追加する
- 対象のレコードがDictionaryオブジェクトに存在するかをチェックする
- Dictionaryオブジェクトに存在するキーと要素を使った値の処理
今回はの記事は、上記の3ステップ目、Dictionaryオブジェクトに存在するキーと要素を使った値の処理のご紹介として、複数のLoopで書かれたリストの重複排除のコードを、Dictionaryオブジェクトを使ったコードに置き換えていきましょう！
ステップ1とステップ2の処理については、下記の記事をご覧くださいね。
重複を排除したいリスト
前々回の記事でお見せした、こちらのリスト。
このリストのB列の品目が同じレコードは在庫数を加算し、重複を取り除いてF、G列に出力したい場合のコードはこんな感じでした。
Sub TestList()
Dim i As Long '左側リストの処理行
Dim j As Long '右側リストの出力行
Dim flgFind As Long '重複発見フラグ
Dim maxRow As Long '左側リストのレコード件数
Dim maxRow_l As Long '右側リストの件数
Dim strMat, lngNum 'セルの値格納用
With ActiveSheet
maxRow = .Cells(Rows.Count, 2).End(xlUp).Row
maxRow_l = 1
For i = 2 To maxRow
flgFind = 0
For j = 1 To maxRow_l
strMat = .Cells(i, 2).Value
lngNum = .Cells(i, 3).Value
If strMat = .Cells(j, 6).Value Then
.Cells(j, 7).Value = .Cells(j, 7).Value + lngNum
flgFind = 1
Exit For
End If
Next j
If flgFind = 0 Then
.Cells(j, 6).Value = strMat
.Cells(j, 7).Value = lngNum
maxRow_l = maxRow_l + 1
End If
Next i
End With
End Sub
では、このコードをDictionaryオブジェクトを使ったコードに置き換えていきましょう！
Dictionaryオブジェクトを使ったコードに置き換える
Dictionaryオブジェクトの宣言をする
まずは、Dictionaryオブジェクトの宣言をしましょう。
Dim dic As Dictionary Set dic = New Dictionary
Microsoft Scripting Runtimeの参照設定も忘れずに行っておきます。
AddメソッドでDictionaryオブジェクトにキーと要素を追加
次に、左側で参照していく品目を、Addメソッドを使ってDictionaryオブジェクトに追加しましょう。
Dictionaryオブジェクトのキーは品目の値を、要素には右側に出力する行番号をセットしておきます。
With ActiveSheet
dic.Add .Cells(i, 2).Value, j
End With
Existsメソッドで重複の有無をチェック
右側に品目を追加するのは、左側の処理対象行の品目が右側のリストにある品目と重複しない場合です。
なので、Dictionaryオブジェクトには、右側のリストにまだ存在していない品目をキーとして追加していきます。
Dictionaryオブジェクトに、指定したキーが存在しているかをチェックするには、Existsメソッドを使うのでしたね。
なので、
With ActiveSheet
If dic.Exists(.Cells(i, 2).Value) Then
dic.Add .Cells(i, 2).Value, j
End If
End With
これで重複チェックができます。
If文で重複の有無によって処理を分岐させる
さらに、
- 重複していたら、左側のリストの在庫数を、Dictionaryに登録されているキーの行番号に対応する右側のリストの在庫数に加算(Existsメソッドの返り値がTrueの場合)
- 重複していなかったら品目と右側のリストに出力する行番号をDictionaryオブジェクトに追加して、かつ右側のリストにも出力(Existsメソッドの返り値がFalseの場合)
という処理も追加します。
こんな感じ。
With ActiveSheet
If dic.Exists(strMat) Then
.Cells(.Cells(i, 2).Value, 7).Value = .Cells(dic.Item(.Cells(i, 2).Value), 7).Value + .Cells(i, 3).Value
Else
dic.Add (.Cells(i, 2).Value), j
.Cells(j, 6).Value = .Cells(i, 2).Value
.Cells(j, 7).Value = .Cells(i, 3).Value
j = j + 1
End If
End With
置き換え後のコード
上で置き換えていったコードを、元コード同様に読込んだセルの値を変数へ格納しつつ、元のコードと置き換えてみるとこんな感じになります。
Sub ListWithDictionary()
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
End Sub
For i = 2 To maxRow ～から Next i までのコードがそっくり入れ替わっていますね。
これで、複数のループを使うことなく、リストの重複処理ができるコードに置き換えることができました！
最後に
今回は、複数のループで書かれたリストの重複処理排除の処理を、Dictionaryを使ったコードに置き換えていきました。
次回は、Dictionaryオブジェクトを使って書かれたコードと、複数のループで書かれたコードの処理速度を比較してみたいと思います。
それでは、最後までお読みいただきありがとうございました！
連載目次：エクセルVBAのDictionaryオブジェクトでリストの重複を排除する
エクセルVBAでリストの重複を排除する方法として、Dictionaryオブジェクトを使った重複排除の方法をご紹介しています。
コメント
いつも勉強させて頂いております。
本件の最終コード欄、一箇所重複ではないでしょうか。
For i = 2 To maxRow
maxRow = .Cells(Rows.Count, 2).End(xlUp).Row
西尾さま
ご指摘ありがとうございます。
おっしゃる通りですね。
修正させていただきました。
ご回答ありがとうございました！
混乱解消しました。
引き続き、勉強続けてまいります。
宜しくお願い致します！