Office TANAKA - Excel VBA Tips[重複しないリストを作る]

ここでは下図のようなリストを例にします。セル範囲A2:A8に名前が入力されていますが、よく見ると(よく見なくても)同じ名前が重複しています。このリストから重複しないリストを作成します。力技も含めていろいろな方法が考えられますが、ここではScripting Runtimeオブジェクトライブラリ内のDictionaryオブジェクトを使います。Scripting RuntimeオブジェクトライブラリはOffice 2000以降のOfficeをインストールすると自動的に組み込まれます。

Dictionaryオブジェクトは本来「連想配列」を作成するために使うオブジェクトです。連想配列とは、たとえば次のような配列です。

キー	値
東京都	新宿区
神奈川県	横浜市
千葉県	千葉市
埼玉県	さいたま市
茨城県	水戸市

「キー」と「値」がセットになっていて、「神奈川県」というキーで「横浜市」という値を検索できるような仕組みです。Dictionaryオブジェクトでは、こうした連想配列にデータ(キーと値のセット)を追加したり、検索したり、任意のキーがすでに存在しているかどうかを調べことなどができます。なお、連想配列では同じキーを登録できません。

Dictionaryオブジェクトを使って重複しないリストを作成するには、次のように考えます。

(1)セルA2からセルA8まで順にデータを取得します
(2)取得したデータが連想配列に登録されていなかったら登録します
(3)取得したデータが連想配列に登録されていたら何もしません

流れはこんな感じです。
さて登録するデータですが、連想配列では「キー」と「値」の二つが必要です。今回のケースでは「名前」データしかありません。「名前」を「キー」にするとして、「値」には何を登録したらいいのでしょう。
何でもいいんです。ここで重要なことは重複しない「キー」の集まりを作ることです。「値」はすべて空欄でもいいですし「キー」と同じ「名前」を登録してもかまいません。コードにすると次のようになります。

Sub Sample1()
    Dim Dic, i As Long, buf As String
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 2 To 8                      ''セルA2からセルA8までを処理する
        buf = Cells(i, 1).Value         ''セルの値を変数bufに格納する
        If Not Dic.Exists(buf) Then     ''まだ登録されていなかったら…
            Dic.Add buf, buf            ''セルの値を連想配列に登録する
        End If
    Next i
    MsgBox Dic.Count
    Set Dic = Nothing
End Sub

Existsメソッドは、指定したキーが、連想配列内に存在していたときTrueを返し、存在しないときはFalseを返します。先に例として紹介した「県庁所在地」の連想配列でしたら、Exists("千葉県")はTrueで、Exists("静岡県")はFalseとなります。Addメソッドは、連想配列に新しい「キー」と「値」のセットを追加します。最後のCountプロパティは、連想配列内のデータ組数を返します。

せっかく重複しないリストを作成しても、ただ個数を確認するだけでは実用的とは言えませんね。作成したリストを別のセルに出力するには次のようにします。

Sub Sample2()
    Dim Dic, i As Long, buf As String, Keys
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 2 To 8
        buf = Cells(i, 1).Value
        If Not Dic.Exists(buf) Then
            Dic.Add buf, buf
        End If
    Next i
    ''出力
    Keys = Dic.Keys
    For i = 0 To Dic.Count - 1
        Cells(i + 2, 2) = Keys(i)
    Next i
    Set Dic = Nothing
End Sub

さてさて、実はもう少し手抜きの方法がありますのでお教えします。
上の流れは「これから登録しようとするデータがすでに登録されているかどうか」をExistsメソッドで確認しました。連想配列では同じキーを重複して登録できないからです。では、同じキーを登録しようとしたらどうなるのでしょう。エラーになります。ということは「登録してみてエラーになったら無視(何もしない)」という手が使えそうです。

Sub Sample3()
    Dim Dic, i As Long, buf As String, Keys
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For i = 2 To 8
        buf = Cells(i, 1).Value
        Dic.Add buf, buf
    Next i
    ''出力
    Keys = Dic.Keys
    For i = 0 To Dic.Count - 1
        Cells(i + 2, 2) = Keys(i)
    Next i
    Set Dic = Nothing
End Sub