アフィリエイト・アドセンス広告を利用しています。詳細は こちら



Excel VBA - 複数項目完全一致重複データ除外処理メモ

Excel VBA で複数項目が完全に一致した重複データを除外する VBA コードを公開します。

Excel と Excel Visual Basic Editor(VBE)の環境設定については 以前公開した記事 より、VBA コードの基本的な内容については こちらの記事 よりご確認ください。

Excel VBA - 複数項目完全一致重複データ除外処理メモ


複数項目完全一致重複データ除外用サンプルファイル(xlsx ファイル)

複数項目完全一致重複データ除外用のサンプルファイル(xlsx ファイル)を公開します。

サンプルデータは Start Point さんのところで公開しているコピペで使える都道府県一覧リスト・県庁所在地一覧 を加工しています。

こちらで作成した 都道府県県庁所在地地方区分重複削除A.xlsx ファイル都道府県県庁所在地地方区分重複削除B.xlsx ファイル を用意しました。ファイル名リンクをクリックすると Google ドライブからダウンロードするようにしています。

都道府県県庁所在地地方区分重複削除A.xlsx ファイル は VBA コードを実行する前の状態、都道府県県庁所在地地方区分重複削除B.xlsx ファイル は VBA コード実行後の処理結果内容となっています。

いずれも xlsx ファイルとなっており VBA コードは含まれていません。VBA コードを実行するにはファイル拡張子が xlsm(マクロ有効ブック)となっている必要がありますが、xlsm 形式での配布は念のため避けています。

VBA コードを実行するには 都道府県県庁所在地地方区分重複削除A.xlsx ファイル をダウンロード後 xlsm 形式に保存、Visual Basic Editor(VBE)を起動して参照設定から「Microsoft Scripting Runtime」を設定(事前バインディング) します。以降各セクションで紹介している VBA コードを各自追加して実行してもらう形としています。

VBA コードの追加方法は VBE のプロジェクトエクスプローラー(Ctrl + R キー)画面にて、開いている VBAProject(ファイル名.xlsm)→「標準モジュール」を開き、右クリックから「挿入」→「標準モジュール」でクリック、追加した標準モジュールに VBA コードを貼り付けることで動作できるようにしています。

一部 VBA コード内にある Call ステートメントを使った Function プロシージャの呼び出し については、呼び出し先標準モジュールのプロパティ(F4 キー)画面から(オブジェクト名)欄を設定するのが前提となっています。

複数項目が完全に一致した重複データを除外する VBA コードを公開します。VBA コードと詳細な内容については 次のセクション で説明します。

複数項目完全一致重複データ除外処理 VBA サンプルコード

以下、複数項目が完全一致した重複データを除外する VBA サンプルコードです。

この VBA コードはシート「都道府県県庁所在地地方区分重複」にある A 列の都道府県コードから F 列の地方区分まである、ランダムに並べ替えられた重複した都道府県データの中から、完全に一致した重複データを除いた重複しないリスト(ユニークリスト)を作成します。

考え方として、シート「都道府県県庁所在地地方区分重複」には重複した各都道府県のデータがランダムに並び替えられているので、これを連想配列(Dictionary オブジェクト)を使ってキー登録を行い、同じデータを重複登録しようとしたときに弾くことで、重複しないリスト(ユニークリスト)を作成できます。

重複しないリスト(ユニークリスト)作成後、シート「都道府県県庁所在地地方区分重複削除」に反映します。

複数項目が完全一致した重複データの除外処理部分以外の基本的な VBA コードについては 以前公開した記事内容 を参照してください。

次のセクション から複数項目が完全一致した重複データの除外処理がある VBA コード部分について内容を説明します。

その他について以前公開した VBA コードで、LBound と UBound 関数のパラメーターとして配列を返す関数(Split 関数など)を使用すると、メモリリークが起きる可能性があるとの指摘がありました。

ただ、VBA コードのメモリリークについて日本語で言及している情報が少なく、今回公開した VBA コードが原因でメモリリークが起きるかどうか確認できていません。(こちらで単純にメモリリークに気づいていないというのもあります)

こちらのサイト ではメモリリークする・しないコードの書き方が紹介されています。この記事ではこの書き方にならってメモリリーク対策した VBA コードにしています。メモリリークが起きないとされているコード内容に修正しただけなので、実際にメモリリークが起きないかどうかまでは確認していません。

基本的に関数の返り値を一度変数に格納して、その変数を使用する方法に書き換えた内容となっています。メモリリークに対策したコード個所についてはハイライトで表示しておきます。

Option Explicit

Sub DeduplicationFixMemoryLeaks1() ' メモリリーク対策版
  ' シート「都道府県県庁所在地地方区分重複」の重複行削除

  ' 実行速度計測開始
  Dim starttime As Double
  starttime = Timer

' ----------

  ' 変数宣言
  Dim i As Long, k As Long ' カウンタ用変数(一見見分けにくい文字同士を組み合わせない形、i と j、m と n、o(オー) と 0(ゼロ))

' ----------

  ' 変数宣言
  Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet ' シート格納用オブジェクト変数
  
  ' オブジェクト変数にシートセット
  Set ws1 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分重複") ' 重複ありシートをオブジェクト変数にセット
  Set ws2 = ThisWorkbook.Worksheets("都道府県県庁所在地地方区分重複削除") ' 重複削除後転記先シートをオブジェクト変数にセット
'  Set ws3 = ThisWorkbook.Worksheets("temp") ' 出力先テスト用シート

' ----------

  ' 変数宣言
  Dim maxrow1 As Long ' 最終行取得用変数
  Dim maxcol1 As Long ' 最終列取得用変数

  ' シートの最終行・最終列を取得して変数に格納
  maxrow1 = ws1.Cells(Rows.Count, "A").End(xlUp).row
  maxcol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column

' ----------

  ' 変数宣言
  Dim data1() As Variant ' シートの指定したセル範囲を配列として格納する動的配列

  ' シートの指定した範囲内セルを配列として動的配列に格納
  data1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)).Value ' コピー元シート最終行・最終列までを Range で範囲指定、配列として動的配列にセット

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  data1 = GetArrFromRange.GetArrFromRange(ws1.Range(ws1.Cells(2, 1), ws1.Cells(maxrow1, maxcol1)))

' ----------

  ' 重複しない行数登録処理

  ' 変数宣言
  Dim myDic1 As Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Set myDic1 = New Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Dim key1 As String ' Dictionary 用 Key 変数

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_data1_1D As Variant, UB_data1_1D As Variant
  Dim LB_data1_2D As Variant, UB_data1_2D As Variant
  LB_data1_1D = LBound(data1, 1)
  UB_data1_1D = UBound(data1, 1)
  LB_data1_2D = LBound(data1, 2)
  UB_data1_2D = UBound(data1, 2)

  ' 各行すべての列を Key として Dictionary に登録
  For i = LB_data1_1D To UB_data1_1D ' 配列に格納したシートの 1次元最大要素までループ処理
    ' シート i 行目の 1列目~ 6列目のデータ(すべての列)を Dictionary 用 Key 変数にセット
    key1 = data1(i, 1) & "/" & data1(i, 2) & "/" & data1(i, 3) & "/" & data1(i, 4) & "/" & data1(i, 5) & "/" & data1(i, 6)
    ' シート i 行目の 1列目のデータを Dictionary 用 Key 変数にセット
'    key1 = data1(i, 1)

  ' Key 重複登録判定
    If Not myDic1.Exists(key1) Then
      myDic1.Add key1, 1 ' 重複していなければ Key 辞書登録(Item はダミーデータ)
    End If
  Next i

' ----------

  Dim data2() As Variant ' シートの指定したセル範囲を配列として格納する動的配列

  ' シートの指定した範囲内セルを配列として動的配列に格納
  data2 = ws2.Range(ws2.Cells(1, 1), ws2.Cells(myDic1.Count, maxcol1)).Value ' 重複しない行数(myDic1.Count)にあわせてコピー先シート最終行・最終列までを Range で範囲指定、配列として動的配列にセット

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  data2 = GetArrFromRange.GetArrFromRange(ws2.Range(ws2.Cells(1, 1), ws2.Cells(myDic1.Count, maxcol1)))

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_data2_1D As Variant, UB_data2_1D As Variant
  Dim LB_data2_2D As Variant, UB_data2_2D As Variant
  LB_data2_1D = LBound(data2, 1)
  UB_data2_1D = UBound(data2, 1)
  LB_data2_2D = LBound(data2, 2)
  UB_data2_2D = UBound(data2, 2)

  ' 転記先シート 2次元配列の最大要素まで Empty で初期化(繰り返し(やり直し)処理に対応)
  For i = LB_data2_1D To UB_data2_1D ' 1次元最大要素までループ処理
    For k = LB_data2_2D To UB_data2_2D ' 2次元最大要素までループ処理
      data2(i, k) = Empty ' 配列に Empty を代入して初期化
    Next k
  Next i

  ' Redim ステートメントを使った 2次元配列の最大要素までの初期化
'  ReDim data2(1 To UB_data2_1D, 1 To UB_data2_2D)

' ----------

  ' Dictionary オブジェクトの重複判定処理で重複なしデータ作成

  ' 変数宣言
  Dim myDic2 As Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Set myDic2 = New Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Dim key2 As String ' Dictionary 用 Key 変数
  Dim p As Long ' 配列 data2 行番号用変数宣言

  p = 0 ' 配列 data2 行番号変数初期化

  ' 各行すべての列を Key として Dictionary に登録
  For i = LB_data1_1D To UB_data1_1D ' 配列に格納したシートの 1次元最大要素までループ処理
    ' シート i 行目の 1列目~ 6列目のデータ(すべての列)を Dictionary 用 Key 変数にセット
    key2 = data1(i, 1) & "/" & data1(i, 2) & "/" & data1(i, 3) & "/" & data1(i, 4) & "/" & data1(i, 5) & "/" & data1(i, 6)
    ' シート i 行目の 1列目のデータを Dictionary 用 Key 変数にセット
'    key2 = data1(i, 1)

  ' Key 重複登録判定
    If Not myDic2.Exists(key2) Then
      myDic2.Add key2, 1 ' 重複していなければ Key 辞書登録(Item はダミーデータ)

      p = p + 1 ' 配列 data2 行番号変数 p をインクリメント(+1)

      For k = LB_data1_2D To UB_data1_2D ' 2次元最大要素までループ処理
        data2(p, k) = data1(i, k) ' 配列 data1 の i 行 k 列目を配列 data2 の p 行 k 列目にセット
      Next k

    End If
  Next i

' ----------

  ' クイックソート(行方向 - 昇順)
'  Call QuickSortAscRows.QuickSortAscRows(data2, LB_data2_1D, UB_data2_1D, 1)

  ' クイックソート(行方向 - 降順)
'  Call QuickSortDescRows.QuickSortDescRows(data2, LB_data2_1D, UB_data2_1D, 1)

  ' マージソート(行方向 - 昇順)
  Call merge_sort2_asc_rows.merge_sort2_asc_rows(data2, 1)

  ' マージソート(行方向 - 降順)
'  Call merge_sort2_desc_rows.merge_sort2_desc_rows(data2, 1)

' ----------

  ' 動的配列に格納した配列 Item 内容を、検索元シートの Range で指定したセルから Resize で範囲を変更してセルに代入
  ws2.Range("A2").Resize(UB_data2_1D, UB_data2_2D).Value = data2
  ws2.Activate

  ' テスト用シートに出力する場合は以下のテスト用シートを格納したオブジェクト変数に変更
'  ws3.Range("A2").Resize(UB_data2_1D, UB_data2_2D).Value = data2
'  ws3.Activate

' ----------

  ' 実行速度計測結果表示
  Debug.Print Format(Timer - starttime, "0.00秒")

End Sub

連想配列(Dictionary オブジェクト)を使った重複データ除外後のデータ件数カウント処理とデータ格納用 2次元配列作成

  ' 重複しない行数登録処理

  ' 変数宣言
  Dim myDic1 As Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Set myDic1 = New Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Dim key1 As String ' Dictionary 用 Key 変数

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_data1_1D As Variant, UB_data1_1D As Variant
  Dim LB_data1_2D As Variant, UB_data1_2D As Variant
  LB_data1_1D = LBound(data1, 1)
  UB_data1_1D = UBound(data1, 1)
  LB_data1_2D = LBound(data1, 2)
  UB_data1_2D = UBound(data1, 2)

  ' 各行すべての列を Key として Dictionary に登録
  For i = LB_data1_1D To UB_data1_1D ' 配列に格納したシートの 1次元最大要素までループ処理
    ' シート i 行目の 1列目~ 6列目のデータ(すべての列)を Dictionary 用 Key 変数にセット
    key1 = data1(i, 1) & "/" & data1(i, 2) & "/" & data1(i, 3) & "/" & data1(i, 4) & "/" & data1(i, 5) & "/" & data1(i, 6)
    ' シート i 行目の 1列目のデータを Dictionary 用 Key 変数にセット
'    key1 = data1(i, 1)

  ' Key 重複登録判定
    If Not myDic1.Exists(key1) Then
      myDic1.Add key1, 1 ' 重複していなければ Key 辞書登録(Item はダミーデータ)
    End If
  Next i

' ----------

  Dim data2() As Variant ' シートの指定したセル範囲を配列として格納する動的配列

  ' シートの指定した範囲内セルを配列として動的配列に格納
  data2 = ws2.Range(ws2.Cells(1, 1), ws2.Cells(myDic1.Count, maxcol1)).Value ' 重複しない行数(myDic1.Count)にあわせてコピー先シート最終行・最終列までを Range で範囲指定、配列として動的配列にセット

  ' Range オブジェクトを受け取り、2次元配列で返す自作関数 GetArrFromRange
'  data2 = GetArrFromRange.GetArrFromRange(ws2.Range(ws2.Cells(1, 1), ws2.Cells(myDic1.Count, maxcol1)))

  ' LBound・UBound 関数格納用変数と代入(メモリリーク対策)
  Dim LB_data2_1D As Variant, UB_data2_1D As Variant
  Dim LB_data2_2D As Variant, UB_data2_2D As Variant
  LB_data2_1D = LBound(data2, 1)
  UB_data2_1D = UBound(data2, 1)
  LB_data2_2D = LBound(data2, 2)
  UB_data2_2D = UBound(data2, 2)

  ' 転記先シート 2次元配列の最大要素まで Empty で初期化(繰り返し(やり直し)処理に対応)
  For i = LB_data2_1D To UB_data2_1D ' 1次元最大要素までループ処理
    For k = LB_data2_2D To UB_data2_2D ' 2次元最大要素までループ処理
      data2(i, k) = Empty ' 配列に Empty を代入して初期化
    Next k
  Next i

  ' Redim ステートメントを使った 2次元配列の最大要素までの初期化
'  ReDim data2(1 To UB_data2_1D, 1 To UB_data2_2D)

連想配列(Dictionary オブジェクト)を使って重複データ除外後のデータ件数のカウント処理と、データ格納用 2次元配列を作成します。

コード内容は以前公開した記事 「Excel VBA - 連想配列(Dictionary オブジェクト)を使った大量データ高速抽出・集計処理メモ」の連想配列(Dictionary オブジェクト)の辞書登録件数から一時データ格納先 2次元配列作成 と同じです。

以下、相違点があるところについて説明します。

66行目で Dictionary 用キー変数に、シート「都道府県県庁所在地地方区分重複」を格納した 2次元配列 data1 のすべての要素を /(スラッシュ記号)で連結してキーとして代入します。ここでは連結用の文字列として /(スラッシュ記号)を使っていますが、ほかの任意の文字列で代用しても問題ありません。

このようにシート「都道府県県庁所在地地方区分重複」のすべての列にある要素を連結して 1つのキーとして登録することで、すべての要素に完全に一致する重複データを弾くことができます。

重複データの有無を判定する基準を、例えば都道府県コードのように一意(ユニーク)なキーだけで判定するだけで十分な場合は、68行目のように都道府県コードがある 2次元配列をキーに登録するだけで済みます。

以上のように各要素を連結させることによって、Dictionry のキーとして登録する内容を自在にコントロールすることができます。

81~102行目で Dictionary に登録したデータを格納する 2次元配列を作成して、次のセクション ではユニークデータを 2次元配列に格納して重複しないリスト(ユニークリスト)を作成します。

連想配列(Dictionary オブジェクト)を使った重複データ除外後のユニークデータ 2次元配列格納処理

  ' Dictionary オブジェクトの重複判定処理で重複なしデータ作成

  ' 変数宣言
  Dim myDic2 As Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Set myDic2 = New Dictionary ' Dictionary オブジェクト(参照設定 - Microsoft Scripting Runtime 設定が必要)
  Dim key2 As String ' Dictionary 用 Key 変数
  Dim p As Long ' 配列 data2 行番号用変数宣言

  p = 0 ' 配列 data2 行番号変数初期化

  ' 各行すべての列を Key として Dictionary に登録
  For i = LB_data1_1D To UB_data1_1D ' 配列に格納したシートの 1次元最大要素までループ処理
    ' シート i 行目の 1列目~ 6列目のデータ(すべての列)を Dictionary 用 Key 変数にセット
    key2 = data1(i, 1) & "/" & data1(i, 2) & "/" & data1(i, 3) & "/" & data1(i, 4) & "/" & data1(i, 5) & "/" & data1(i, 6)
    ' シート i 行目の 1列目のデータを Dictionary 用 Key 変数にセット
'    key2 = data1(i, 1)

  ' Key 重複登録判定
    If Not myDic2.Exists(key2) Then
      myDic2.Add key2, 1 ' 重複していなければ Key 辞書登録(Item はダミーデータ)

      p = p + 1 ' 配列 data2 行番号変数 p をインクリメント(+1)

      For k = LB_data1_2D To UB_data1_2D ' 2次元最大要素までループ処理
        data2(p, k) = data1(i, k) ' 配列 data1 の i 行 k 列目を配列 data2 の p 行 k 列目にセット
      Next k

    End If
  Next i

' ----------

  ' クイックソート(行方向 - 昇順)
'  Call QuickSortAscRows.QuickSortAscRows(data2, LB_data2_1D, UB_data2_1D, 1)

  ' クイックソート(行方向 - 降順)
'  Call QuickSortDescRows.QuickSortDescRows(data2, LB_data2_1D, UB_data2_1D, 1)

  ' マージソート(行方向 - 昇順)
  Call merge_sort2_asc_rows.merge_sort2_asc_rows(data2, 1)

  ' マージソート(行方向 - 降順)
'  Call merge_sort2_desc_rows.merge_sort2_desc_rows(data2, 1)

連想配列(Dictionary オブジェクト)を使って重複データを除外したユニークデータを 2次元配列に格納します。

重複データを除外したユニークデータの作成には 先ほどの Dictionary オブジェクトを使った VBA コード を再度利用します。

以下各コードについての補足説明です。

Dictionary オブジェクト変数や各種変数は、ここでは一応区別のため新しく宣言しています。

112行目でユニークデータを格納する 2次元配列の行番号を操作する変数を宣言、114行目で一応明示的に 0 に初期化しています。

119行目の Dictionary 用キー変数に、シート「都道府県県庁所在地地方区分重複」を格納した 2次元配列 data1 のすべての要素を / で連結してキーとして代入します。これは 先ほどの VBA コード と同じです。

124行目でキーの重複判定を行い、キーが重複していなければ 133行目までユニークリストを作成するために必要な処理をします。

125行目でキーを辞書登録します。アイテムの登録は不要なためダミーデータとして 1 を入れています。

127行目で 112行目で宣言したユニークデータを格納する 2次元配列の行番号変数 p をインクリメントします。

129~131行目で ユニークデータ格納用2次元配列 data2 に 2次元配列 data1 の各要素を代入して、117行目のループ処理を繰り返します。

以上の処理をすることでユニークリストを作成することができます。

139行目・142行目・145行目は以前紹介したソートプログラムを使った並べ替えです。ここでは都道府県コードをソートキーとしてマージソートを使って 2次元配列を並べ替えています。以下の関連記事で解説していますのでそちらを参照してください。