【エクセルVBA】Dictionaryオブジェクトを使ったリストの重複排除プログラム

dictionary-rewrite_eyecatch

皆様こんにちは、ノグチです。

前回までの複数の記事で、複数のループを使って処理していたリストの重複排除を、下記3ステップでDictionaryオブジェクトを使ったコードに置き換えていく方法をご紹介してきました。

  1. Dictionaryオブジェクトにキーと要素を追加する
  2. 対象のレコードがDictionaryオブジェクトに存在するかをチェックする
  3. Dictionaryオブジェクトに存在するキーと要素を使った値の処理

今回はの記事は、上記の3ステップ目、Dictionaryオブジェクトに存在するキーと要素を使った値の処理のご紹介として、複数のLoopで書かれたリストの重複排除のコードを、Dictionaryオブジェクトを使ったコードに置き換えていきましょう!

ステップ1とステップ2の処理については、下記の記事をご覧くださいね。

【エクセルVBA】AddメソッドでDictionaryオブジェクトにキーと要素を追加する方法
エクセルVBAのDictionaryオブジェクトを使った、リストの重複を排除する方法を連載でご紹介しています。今回は、Dictionaryオブジェクトにキーと要素を追加するAddメソッドのご紹介です。
【エクセルVBA】DictionaryオブジェクトのExistsメソッドで重複があるかを確認する方法
複数のループを使った重複排除のVBAコードを、Dictionaryオブジェクトとメソッドを使ったコードをに置き換えていく方法をご紹介しています。今回は、指定した値がDictionaryオブジェクトに既に登録されているかどうか?をチェックしてくれる、Existsメソッドのご紹介です。
スポンサーリンク

重複を排除したいリスト

前々回の記事でお見せした、こちらのリスト。

excel,dictionary,add,リスト

このリストの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オブジェクト vs 複数ループ
エクセルVBAのDictionaryオブジェクトを使って書かれた重複排除のコードと、複数のループを使った重複排除のコードの処理速度を比較してみました。もしお手元にリストの重複処理などで「遅いなあ...」と感じるコードがあるなら、参考にしてみてください。

それでは、最後までお読みいただきありがとうございました!

連載目次:エクセルVBAのDictionaryオブジェクトでリストの重複を排除する

エクセルVBAでリストの重複を排除する方法として、Dictionaryオブジェクトを使った重複排除の方法をご紹介しています。

  1. 【エクセルVBA】リスト処理に便利!Dictionaryオブジェクトをコードで使うための準備
  2. 【エクセルVBA】AddメソッドでDictionaryオブジェクトにキーと要素を追加する方法
  3. 【エクセルVBA】DictionaryオブジェクトのExistsメソッドで重複があるかを確認する方法
  4. 【エクセルVBA】Dictionaryオブジェクトを使ったリストの重複排除プログラム
  5. 【エクセルVBA】重複排除処理が速いのはどっち?Dictionaryオブジェクト vs 複数ループ
  6. 【エクセルVBA】Dictionaryに格納したキーと要素をリストに書き出す方法

コメント

  1. 西尾 尚 より:

    いつも勉強させて頂いております。
    本件の最終コード欄、一箇所重複ではないでしょうか。

    For i = 2 To maxRow
    maxRow = .Cells(Rows.Count, 2).End(xlUp).Row

    • 西尾さま

      ご指摘ありがとうございます。
      おっしゃる通りですね。

      修正させていただきました。

      • 西尾 尚 より:

        ご回答ありがとうございました!
        混乱解消しました。
        引き続き、勉強続けてまいります。
        宜しくお願い致します!

タイトルとURLをコピーしました