本コンテンツは、たぶん2005年頃に書きました。約15年前です。多くの方が、ここに書いた方法を参考にしてくれていますが、重複しないリストを作るのは、ほかにもたくさんの方法があります。Office TANAKAサイトをリニューアルしたついでに、ほかの方法も書きました。そちらもご覧ください。重要なことは「どの方法がいいか」ではなく「選択肢を広く持つ」ことです。理想は、すべての方法を自在に書けるようになってくださいな。
ここでは下図のようなリストを例にします。セル範囲A2:A8に名前が入力されていますが、よく見ると(よく見なくても)同じ名前が重複しています。このリストから重複しないリストを作成します。力技も含めていろいろな方法が考えられますが、ここではScripting Runtimeオブジェクトライブラリ内のDictionaryオブジェクトを使います。Scripting RuntimeオブジェクトライブラリはOffice 2000以降のOfficeをインストールすると自動的に組み込まれます。
Dictionaryオブジェクトは本来「連想配列」を作成するために使うオブジェクトです。連想配列とは、たとえば次のような配列です。
キー | 値 |
---|---|
東京都 | 新宿区 |
神奈川県 | 横浜市 |
千葉県 | 千葉市 |
埼玉県 | さいたま市 |
茨城県 | 水戸市 |
「キー」と「値」がセットになっていて、「神奈川県」というキーで「横浜市」という値を検索できるような仕組みです。Dictionaryオブジェクトでは、こうした連想配列にデータ(キーと値のセット)を追加したり、検索したり、任意のキーがすでに存在しているかどうかを調べことなどができます。なお、連想配列では同じキーを登録できません。
Dictionaryオブジェクトを使って重複しないリストを作成するには、次のように考えます。
流れはこんな感じです。さて登録するデータですが、連想配列では「キー」と「値」の二つが必要です。今回のケースでは「名前」データしかありません。「名前」を「キー」にするとして、「値」には何を登録したらいいのでしょう。
何でもいいんです。ここで重要なことは重複しない「キー」の集まりを作ることです。「値」はすべて空欄でもいいですし「キー」と同じ「名前」を登録してもかまいません。コードにすると次のようになります。
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