忍者ブログ
VBAによる実用アプリケーションの構築、およびGAS(Google Apps Script)やOffice Scriptへのモダンな移行パスを検証・解説するテックブログ。現場で即戦力となるコードモジュールや再利用可能な実用部品を継続的に提供します。

【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

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

3. このコードのポイント

  • Dictionaryの活用:Scripting.Dictionary の「キー(Key)の重複を許さない」という特性を利用することで、ループで一つずつチェックしながら高速に一意な値を抽出しています。
  • dict.Keys の利用:Dictionaryに登録されたキーの一覧は、そのまま dict.Keys プロパティで0ベースの1次元配列として取得できるため、非常にスマートに記述できます。
  • 幅広いデータ型に対応:Variant 型で受け取っているため、文字列だけでなく数値配列の重複削除にもそのまま流用可能です。

配列のデータを整理・集計したいときは、ぜひこの関数を標準モジュールに組み込んで活用してみてください!



PR