VBAで配列から重複する値を順序を変えずに削除する

Excelの機能を使うかVBAで処理するか

配列データの重複を削除する場合、大きく分けると２つの方法があります。

１つはVBAで配列のループを行い、重複の判定を行って配列の再構築を行う方法です。

この方法はDictionaryクラスを使って高速化する方法と、素直に配列のループで行う方法の２通りが考えられます。

もう１つはExcelの重複の削除機能を使う方法で、処理の実体はRangeオブジェクトのRemoveDuplicatesメソッドを使う方法です。

それぞれサンプルコードも含めて紹介します。

以下では３つのコードを紹介していますが、一番おすすめなのは最初に紹介するDictionaryクラスを使う方法です。

なお、いずれの方法も元の配列の順序は維持しておくようにします。

配列の順序の維持とは、例えば「3,1,2,3,1,1」の6つのデータの重複を除去した場合に「3,1,2」とするか、ソートも行って「1,2,3」のようにしてもいいか、という話ですが、ソートをしたいのであれば重複を除去したあとにすればいい話で、コーディングの作法としては単に除去だけを行う方が都合がいい場合が多いと思います。

配列ループ＋重複判定での配列再構築方法

配列ループの方法はVBAだけで完結したい場合に考え付く方法だと思います。

配列の中で重複している値を削除するには、配列に格納されている値の中でどれが重複しているのかを検出する必要があります。

そのため、最低１回は配列に各要素に格納されている値がなんであるかを確認する必要があります。

その際に、既に格納済みの値かどうかを確認すれば、重複しているかどうかが判定できます。

この考え方をそのままコードにすると、配列の二重ループ方式になります。

ただその場合、配列の要素が多い場合に処理に時間が掛かる欠点があります。

それを改善したい場合はDictionaryクラスなどのハッシュの考え方を利用します。

以下では高速に処理できるDictionaryクラスを使う方法と、処理時間が掛かる二重ループの方法の両方を紹介します。

Dictionaryクラスを使う重複除去

Dictionaryクラスを使うためには事前にVBA画面のツールメニュー→参照設定を選び、参照設定ダイアログで「Microsoft Scripting Runtime」にチェックを付けおく必要があります。

Dictionaryクラスの詳細については「VBAのDictionaryの使い方（全メソッドとプロパティ網羅）」をご参照ください。

処理の概要は、引数の配列をループして、各ループの値がDictionaryクラスにあれば何もせず、なければDictionaryクラスと編集用の配列に格納しています。

Dictionaryクラスは重複の有無判定のみに使用します。

DictionaryクラスのKeysをそのまま配列として返すことも出来ますが、その場合配列の元の順序が維持されない恐れがあるため利用せず、編集用の配列を別途利用しています。

Sub DeleteSameValue1(ar())
    Dim dic As New Dictionary   '// 重複を除いた値を格納するDictionary
    Dim i                       '// ループカウンタ１
    Dim ii                      '// ループカウンタ２
    Dim iLen                    '// 配列要素数
    Dim arEdit()                '// 編集後の配列
    
    ReDim arEdit(0)
    iLen = UBound(ar)
    
    '// 配列ループ
    For i = 0 To iLen
        '// 配列に未登録の値の場合
        If (dic.Exists(ar(i)) = False) Then
            '// Dictionaryに追加
            Call dic.Add(ar(i), ar(i))
            
            '// 重複がない値のみを編集後配列に格納する
            arEdit(UBound(arEdit)) = ar(i)
            ReDim Preserve arEdit(UBound(arEdit) + 1)
        End If
    Next
    
    '// 配列に格納済みの場合
    If (IsEmpty(arEdit(0)) = False) Then
        '// 余分な領域を削除
        ReDim Preserve arEdit(UBound(arEdit) - 1)
    End If
    
    '// 引数に編集後配列を設定
    ar = arEdit
End Sub

Sub DeleteSameValue1(ar())

Dim dic As New Dictionary '// 重複を除いた値を格納するDictionary

Dim i '// ループカウンタ１

Dim ii '// ループカウンタ２

Dim iLen '// 配列要素数

Dim arEdit() '// 編集後の配列

ReDim arEdit(0)

iLen = UBound(ar)

'// 配列ループ

For i = 0 To iLen

'// 配列に未登録の値の場合

If (dic.Exists(ar(i)) = False) Then

'// Dictionaryに追加

Call dic.Add(ar(i), ar(i))

'// 重複がない値のみを編集後配列に格納する

arEdit(UBound(arEdit)) = ar(i)

ReDim Preserve arEdit(UBound(arEdit) + 1)

End If

'// 配列に格納済みの場合

If (IsEmpty(arEdit(0)) = False) Then

'// 余分な領域を削除

ReDim Preserve arEdit(UBound(arEdit) - 1)

End If

'// 引数に編集後配列を設定

ar = arEdit

End Sub

次のコードはのDeleteSameValue1関数を呼ぶテスト用の関数です。

配列に「3, 1, 2, 3, 1, 1」の６つのデータがあり、重複を除いて「3, 1, 2」で返してもらいます。

Sub DeleteSameValue1Test()
    Dim ar()
    
    ar = Array(3, 1, 2, 3, 1, 1)
    
    Call DeleteSameValue1(ar)
    
    Dim s
    For Each s In ar
        Debug.Print s
    Next
End Sub

Sub DeleteSameValue1Test()

Dim ar()

ar = Array(3, 1, 2, 3, 1, 1)

Call DeleteSameValue1(ar)

Dim s

For Each s In ar

Debug.Print s

End Sub

実行結果
3
1
2

参考：配列二重ループでの重複除去

以下は引数に渡された配列から重複を除く関数（DeleteSameValue2）です。

関数内部で編集用の配列を用意します。

元の配列をループして、編集用の配列に格納されていなければ格納し、格納済みであれば重複データとして除外します。

この方式の欠点として、コードの形式として２つの配列が親子関係の二重ループになるため、処理時間も引数の配列のサイズにある程度比例することになります。

また、DictionaryクラスのExistsメソッドに該当する存在チェック処理が必要になるためどうしてもコードが長くなります。

実行結果は上と同じ結果になるため省略します。

Sub DeleteSameValue2(ar())
    Dim i                   '// ループカウンタ１
    Dim ii                  '// ループカウンタ２
    Dim iLen                '// 配列要素数
    Dim arEdit()            '// 編集後の配列
    Dim iEdit               '// 編集後配列のインデックス
    Dim flg     As Boolean  '// 重複有無判定フラグ（True：重複あり、False：なし）
    
    ReDim arEdit(0)
    iLen = UBound(ar)
    
    '// 配列ループ
    For i = 0 To iLen
        '// 重複有無判定フラグを重複なしとして初期化
        flg = False
        
        '// 重複除去済みの編集後配列ループ
        For iEdit = 0 To UBound(arEdit)
            '// 編集後配列に格納済みの場合
            If (ar(i) = arEdit(iEdit)) Then
                flg = True
                Exit For
            End If
        Next
        
        '// 現ループの値には重複がない場合
        If (flg = False) Then
            '// 重複がない値のみを編集後配列に格納する
            arEdit(UBound(arEdit)) = ar(i)
            ReDim Preserve arEdit(UBound(arEdit) + 1)
        End If
    Next
    
    '// 配列に格納済みの場合
    If (IsEmpty(arEdit(0)) = False) Then
        '// 余分な領域を削除
        ReDim Preserve arEdit(UBound(arEdit) - 1)
    End If
    
    '// 引数に編集後配列を設定
    ar = arEdit
End Sub

Sub DeleteSameValue2(ar())

Dim i '// ループカウンタ１

Dim ii '// ループカウンタ２

Dim iLen '// 配列要素数

Dim arEdit() '// 編集後の配列

Dim iEdit '// 編集後配列のインデックス

Dim flg As Boolean '// 重複有無判定フラグ（True：重複あり、False：なし）

ReDim arEdit(0)

iLen = UBound(ar)

'// 配列ループ

For i = 0 To iLen

'// 重複有無判定フラグを重複なしとして初期化

flg = False

'// 重複除去済みの編集後配列ループ

For iEdit = 0 To UBound(arEdit)

'// 編集後配列に格納済みの場合

If (ar(i) = arEdit(iEdit)) Then

flg = True

Exit For

End If

'// 現ループの値には重複がない場合

If (flg = False) Then

'// 重複がない値のみを編集後配列に格納する

arEdit(UBound(arEdit)) = ar(i)

ReDim Preserve arEdit(UBound(arEdit) + 1)

End If

'// 配列に格納済みの場合

If (IsEmpty(arEdit(0)) = False) Then

'// 余分な領域を削除

ReDim Preserve arEdit(UBound(arEdit) - 1)

End If

'// 引数に編集後配列を設定

ar = arEdit

End Sub

Excelの重複の削除機能を使う方法

Excelの重複の削除機能を使う場合、先にも書きましたが処理の実体はセルを扱うRangeオブジェクトのRemoveDuplicatesメソッドです。

重複の削除機能は、対象のセル範囲の中で重複があれば削除して再表示する、という動きになります。

そのため、除去する前のデータをワークシートのセルに設定しておくことが前提になります。

そのため制約事項として、シートの最大行数（Excel 2007以降は1048576行）を超えるデータ数の場合は扱えないことになるため、セルへのデータ貼り付け時にエラーになるため処理しないようにしています。

配列データを貼り付けるシートをどうやって用意するか、という問題がありますが、ここではワークブックに新規シートを追加して、処理が終わったら追加したシートを削除する、という処理にしています。

セルに値を入力することになるため、セルの表示形式によって値が変わらないように表示形式を「文字列」にしてから配列の値をセルに設定しています。

配列データをセルに設定後にRemoveDuplicatesメソッドを使って重複を除去します。

あとは、配列をRedimで重複除去後の要素数で再構築しなおして、セルの値を再度配列に設定しなおしています。

Sub DeleteSameValue3(ar())
    Dim sName       '// 新規シート名
    Dim iLen        '// 配列要素数
    Dim i           '// ループカウンタ
    
    iLen = UBound(ar) + 1
    If (iLen > Rows.Count) Then
        Debug.Print "配列要素数が多すぎます" & iLen
        Exit Sub
    End If
    
    '// 新規シート追加
    ActiveWorkbook.Worksheets.Add
    '// 追加シートの名前を保持
    sName = ActiveSheet.Name
    
    '// セルの表示形式を文字列に設定
    Range(Cells(1, 1), Cells(iLen, 1)).NumberFormat = "@"
    
    '// シートに配列データを貼り付け
    Range(Cells(1, 1), Cells(iLen, 1)).Value = WorksheetFunction.Transpose(ar)
    '// 重複を削除
    Call Range(Cells(1, 1), Cells(iLen, 1)).RemoveDuplicates(Columns:=1, Header:=xlNo)
    
    '// 重複削除後のセル入力範囲の行数を配列の要素数として配列を再構築する
    iLen = ActiveSheet.UsedRange.Rows.Count
    ReDim ar(iLen - 1)
    
    '// 配列にセル値を設定
    For i = 0 To iLen - 1
        '// セルの表示値を配列に設定
        ar(i) = Cells(i + 1, 1).Text
    Next
    
    '// シート削除時の確認ダイアログを非表示化
    Application.DisplayAlerts = False
    
    '// 処理が終わったため追加シートを削除
    Worksheets(sName).Delete
End Sub

Sub DeleteSameValue3(ar())

Dim sName '// 新規シート名

Dim iLen '// 配列要素数

Dim i '// ループカウンタ

iLen = UBound(ar) + 1

If (iLen > Rows.Count) Then

Debug.Print "配列要素数が多すぎます" & iLen

Exit Sub

End If

'// 新規シート追加

ActiveWorkbook.Worksheets.Add

'// 追加シートの名前を保持

sName = ActiveSheet.Name

'// セルの表示形式を文字列に設定

Range(Cells(1, 1), Cells(iLen, 1)).NumberFormat = "@"

'// シートに配列データを貼り付け

Range(Cells(1, 1), Cells(iLen, 1)).Value = WorksheetFunction.Transpose(ar)

'// 重複を削除

Call Range(Cells(1, 1), Cells(iLen, 1)).RemoveDuplicates(Columns:=1, Header:=xlNo)

'// 重複削除後のセル入力範囲の行数を配列の要素数として配列を再構築する

iLen = ActiveSheet.UsedRange.Rows.Count

ReDim ar(iLen - 1)

'// 配列にセル値を設定

For i = 0 To iLen - 1

'// セルの表示値を配列に設定

ar(i) = Cells(i + 1, 1).Text

'// シート削除時の確認ダイアログを非表示化

Application.DisplayAlerts = False

'// 処理が終わったため追加シートを削除

Worksheets(sName).Delete

End Sub

次のコードはDeleteSameValue3関数を呼び出すテスト用関数です。

Sub DeleteSameValue3Test()
    Dim ar()
    
    ar = Array(3, 1, 2, 3, 1, 1)
    
    Call DeleteSameValue3(ar)
    
    Dim s
    For Each s In ar
        Debug.Print s
    Next
End Sub

Sub DeleteSameValue3Test()

Dim ar()

ar = Array(3, 1, 2, 3, 1, 1)

Call DeleteSameValue3(ar)

Dim s

For Each s In ar

Debug.Print s

End Sub

実行結果
3
1
2

Excelの機能を使うかVBAで処理するか

配列ループ＋重複判定での配列再構築方法

Dictionaryクラスを使う重複除去

参考：配列二重ループでの重複除去

Excelの重複の削除機能を使う方法

関連記事