エクセルVBA 同じ項目をまとめる（重複データの整理）コード作成

Dictionaryオブジェクト使って、リスト中の同じ項目をまとめる、重複データの整理するVBAコードを作成します。手法はいくつかありますが、簡潔で速い処理のコードになります。

今回は、同じ項目を一つにまとめるためのエクセルVBAコードを紹介します。

多数銘柄の商品を複数の店で扱っている場合、商品銘柄集計表を作るには、商品銘柄の種類だけをリストにしないといけません。普通に考えても面倒です。

こんにちは、じゅんぱ店長（@junpa33）です。

セルの編集

コンテンツ

エクセルVBA 同じ項目をまとめる（重複データの整理）

結構、実務上のエクセル操作で同じ項目を「ひとつにまとめたいなぁ！」という時があります。

出来そうで出来ない、力わざで出来ても大変時間がかかるなんてことがありますよね。

例えば「並び替え」をして重複項目を一個ずつ削除するとか・・・

今回の例題は、そんなチョッと悩ましいパターンのものを準備しました。

VBAコードの作成は面倒くさいし「力わざの並び替え削除」も出来そうなリストです。

今回の例題

今回は日ごとに販売した雑誌リストの積み上げという想定で、

雑誌名と雑誌コードを一覧表化しています。

この表を重複データの整理をしてD列とE列に表示したいと思います。

Dictionaryオブジェクトを使います

エクセルVBAで問題解決していくのに、Dictionaryオブジェクト（連想配列）を使います。配列としてはキーとデータが1ペアとなります。

キーは、言えば「見出し」的なもので、重複をしてはいけません。（重複させようとしたときはエラーになります。）

データは、そのキーに紐づいた値になります。こちらは、重複してるかどうかは問いません。

そして、この配列のインデックス番号は0から始まります。

構文

CreateObject関数でDictionaryオブジェクトを指定します。

CreateObject(“Scripting.Dictionary”)

Setステートメントで戻り値をオブジェクト変数をオブジェクト変数に代入する。

Set オブジェクト変数 = CreateObject(“Scripting.Dictionary”)

メソッド

オブジェクト変数. Add Key, Item・・・キーとデータをペアで配列にして追加します。

オブジェクト変数. Keys ・・・キーを配列にして返します。

オブジェクト変数. Items・・・キーに紐づいたデータを配列にして返します。

同じ項目をまとめる重複整理のVBAコード

同じ項目をまとめるコード

今回の例題は、連想配列の基本構文的なものになっています。

ほぼコピペそのままで転用してもらえると思います。

重複を整理した連想配列の値を、表示するセルをどこにするかは、

お望みで、別シートとか別BOOKとかも指定いただければと思います。

VBA

Option Explicit

Sub 雑誌名重複整理()
    Dim Arow As Long
    Dim i As Long, j As Long
    Dim myDic As Object
    Dim mykeys, myItems
'Setステートメントで戻り値をオブジェクト変数に代入する
        Set myDic = CreateObject("Scripting.Dictionary")
'A列でリストの最終行を調べる
        Arow = Cells(Rows.Count, 1).End(xlUp).Row
'連想配列、キー重複の時エラーを無視
        On Error Resume Next
        For i = 2 To Arow
'連想配列、キーとデータを追加する
            myDic.Add Worksheets("Sheet1").Cells(i, 1).Value, _
                Worksheets("Sheet1").Cells(i, 2).Value
        Next i
        For j = 0 To myDic.Count - 1
            mykeys = myDic.keys
            myItems = myDic.Items
'キーとデータをセルに表示する
            Range("D" & j + 2).Value = mykeys(j)
            Range("E" & j + 2).Value = myItems(j)
        Next j
'オブジェクトを解放する
        Set myDic = Nothing
End Sub

実行結果

赤枠部分に重複をまとめた項目が表示されました。