【Excel VBA】配列の重複削除をスマートに実装する(Scripting.Dictionary活用法とテストコード付き)
Excel VBAでプログラミングをしていると、「配列の中に含まれている重複した値を削除して、一意な(ユニークな)リストを作りたい」という場面に頻繁に出くわします。
セル範囲(Range)であれば RemoveDuplicates メソッドが使えますが、メモリ上の配列(Array)を処理するには少し工夫が必要です。
この記事では、高速かつシンプルに配列の重複を削除できる Scripting.Dictionary を使った汎用関数と、その実装コード・実行結果をご紹介します。
1. サンプルコード(重複削除関数 & テストコード)
文字列や数値が混在するVariant型の1次元配列を受け取り、重複を排除した新しい配列を返す関数と、動作確認用のテストプロシージャです。これを標準モジュールに貼り付けて使用します。
' [機能名] 配列内の重複要素を削除し、一意な要素のみの配列を返す
' [引数] targetArray : 重複を削除したい1次元配列(Variant)
' [戻り値] 重複が削除された1次元配列
Public Function RemoveDuplicates(ByRef targetArray As Variant) As Variant
' 引数が配列かどうかのチェック
If Not IsArray(targetArray) Then
Err.Raise 13, , "引数に配列を指定してください。"
End If
' 配列が空の場合のハンドリング
On Error Resume Next
Dim lB As Long, uB As Long
lB = LBound(targetArray)
uB = UBound(targetArray)
If Err.Number <> 0 Then
RemoveDuplicates = Array()
Exit Function
End If
On Error GoTo 0
' Dictionaryオブジェクトの生成(重複排除用)
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
Dim v As Variant
For i = lB To uB
v = targetArray(i)
If Not dict.Exists(v) Then
dict.Add v, True
End If
Next i
' 結果の配列を返す(dict.Keysは0ベースの配列を返す)
If dict.Count = 0 Then
RemoveDuplicates = Array()
Else
RemoveDuplicates = dict.Keys
End If
End Function
' [機能名] 動作テスト用プロシージャ
Public Sub Test_RemoveDuplicates()
Dim i As Long
' --- テスト1: 文字列の重複あり配列 ---
Dim strArr As Variant
strArr = Array("Apple", "Banana", "Apple", "Orange", "Banana", "Grape")
Debug.Print "=== [テスト1] 文字列の重複削除 ==="
Debug.Print "-- 削除前(元配列) --"
For i = LBound(strArr) To UBound(strArr)
Debug.Print " [" & i & "] " & strArr(i)
Next i
Dim resStr As Variant
resStr = RemoveDuplicates(strArr)
Debug.Print "-- 削除後(結果配列) --"
For i = LBound(resStr) To UBound(resStr)
Debug.Print " [" & i & "] " & resStr(i)
Next i
Debug.Print ""
' --- テスト2: 数値の重複あり配列 ---
Dim numArr As Variant
numArr = Array(10, 20, 10, 30, 20, 40, 10)
Debug.Print "=== [テスト2] 数値の重複削除 ==="
Debug.Print "-- 削除前(元配列) --"
For i = LBound(numArr) To UBound(numArr)
Debug.Print " [" & i & "] " & numArr(i)
Next i
Dim resNum As Variant
resNum = RemoveDuplicates(numArr)
Debug.Print "-- 削除後(結果配列) --"
For i = LBound(resNum) To UBound(resNum)
Debug.Print " [" & i & "] " & resNum(i)
Next i
End Sub
' [引数] targetArray : 重複を削除したい1次元配列(Variant)
' [戻り値] 重複が削除された1次元配列
Public Function RemoveDuplicates(ByRef targetArray As Variant) As Variant
' 引数が配列かどうかのチェック
If Not IsArray(targetArray) Then
Err.Raise 13, , "引数に配列を指定してください。"
End If
' 配列が空の場合のハンドリング
On Error Resume Next
Dim lB As Long, uB As Long
lB = LBound(targetArray)
uB = UBound(targetArray)
If Err.Number <> 0 Then
RemoveDuplicates = Array()
Exit Function
End If
On Error GoTo 0
' Dictionaryオブジェクトの生成(重複排除用)
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
Dim v As Variant
For i = lB To uB
v = targetArray(i)
If Not dict.Exists(v) Then
dict.Add v, True
End If
Next i
' 結果の配列を返す(dict.Keysは0ベースの配列を返す)
If dict.Count = 0 Then
RemoveDuplicates = Array()
Else
RemoveDuplicates = dict.Keys
End If
End Function
' [機能名] 動作テスト用プロシージャ
Public Sub Test_RemoveDuplicates()
Dim i As Long
' --- テスト1: 文字列の重複あり配列 ---
Dim strArr As Variant
strArr = Array("Apple", "Banana", "Apple", "Orange", "Banana", "Grape")
Debug.Print "=== [テスト1] 文字列の重複削除 ==="
Debug.Print "-- 削除前(元配列) --"
For i = LBound(strArr) To UBound(strArr)
Debug.Print " [" & i & "] " & strArr(i)
Next i
Dim resStr As Variant
resStr = RemoveDuplicates(strArr)
Debug.Print "-- 削除後(結果配列) --"
For i = LBound(resStr) To UBound(resStr)
Debug.Print " [" & i & "] " & resStr(i)
Next i
Debug.Print ""
' --- テスト2: 数値の重複あり配列 ---
Dim numArr As Variant
numArr = Array(10, 20, 10, 30, 20, 40, 10)
Debug.Print "=== [テスト2] 数値の重複削除 ==="
Debug.Print "-- 削除前(元配列) --"
For i = LBound(numArr) To UBound(numArr)
Debug.Print " [" & i & "] " & numArr(i)
Next i
Dim resNum As Variant
resNum = RemoveDuplicates(numArr)
Debug.Print "-- 削除後(結果配列) --"
For i = LBound(resNum) To UBound(resNum)
Debug.Print " [" & i & "] " & resNum(i)
Next i
End Sub
2. イミディエイトウィンドウの実行結果
上記の Test_RemoveDuplicates を実行すると、イミディエイトウィンドウに次のように出力されます。
=== [テスト1] 文字列の重複削除 ===
-- 削除前(元配列) --
[0] Apple
[1] Banana
[2] Apple
[3] Orange
[4] Banana
[5] Grape
-- 削除後(結果配列) --
[0] Apple
[1] Banana
[2] Orange
[3] Grape
=== [テスト2] 数値の重複塩削除 ===
-- 削除前(元配列) --
[0] 10
[1] 20
[2] 10
[3] 30
[4] 20
[5] 40
[6] 10
-- 削除後(結果配列) --
[0] 10
[1] 20
[2] 30
[3] 40
-- 削除前(元配列) --
[0] Apple
[1] Banana
[2] Apple
[3] Orange
[4] Banana
[5] Grape
-- 削除後(結果配列) --
[0] Apple
[1] Banana
[2] Orange
[3] Grape
=== [テスト2] 数値の重複塩削除 ===
-- 削除前(元配列) --
[0] 10
[1] 20
[2] 10
[3] 30
[4] 20
[5] 40
[6] 10
-- 削除後(結果配列) --
[0] 10
[1] 20
[2] 30
[3] 40
3. このコードのポイント
- Dictionaryの活用:
Scripting.Dictionaryの「キー(Key)の重複を許さない」という特性を利用することで、ループで一つずつチェックしながら高速に一意な値を抽出しています。 dict.Keysの利用:Dictionaryに登録されたキーの一覧は、そのままdict.Keysプロパティで0ベースの1次元配列として取得できるため、非常にスマートに記述できます。- 幅広いデータ型に対応:
Variant型で受け取っているため、文字列だけでなく数値配列の重複削除にもそのまま流用可能です。
配列のデータを整理・集計したいときは、ぜひこの関数を標準モジュールに組み込んで活用してみてください!
PR