配列の重複除去 ② 二次元配列から任意の一列を抜き出して新たな配列作成

昨日は任意の一次元配列について、重複除去するユーザー定義関数を考えてみた。
infoment.hatenablog.com

しかし実際、自分の場合に限って言えば、一次元ではなく二次版配列の任意の一列を抜き出したうえで重複除去することの方が多い。
そこで、一次元と二次元のどちらにも対応できるよう、機能拡張してみた。

今回の作戦は、こんな感じだ。

1. 引数に、二次元配列の場合に抜き出す列番号を追加。
2. 本来配列を受け取るはずの引数に、配列以外がセットされた場合の処理追加。
3. 配列の次元確認（三次元以上は処理対象外とする）。
4. 重複除去。

これを元にして、昨日の関数を書き直してみた。

Function RemovalDuplicateArray(source_array As Variant, _
                      Optional target_column_index As Long = 1) As Variant
                      
    ' 配列確認。
    ' 引数に値以外がセットされる場合を想定し、一時的にエラーを無視。
        On Error Resume Next
        If IsArray(source_array) = False Then
            RemovalDuplicateArray = Array(source_array)
            Exit Function
        End If
    
    ' 配列の次元数を確認。
    Dim i As Long
        For i = 1 To 3
            Debug.Print UBound(source_array, i)
            If Err.Number <> 0 Then Exit For
        Next
    
    Dim DimensionNumber As Long
        DimensionNumber = i - 1
    
    ' 作業用配列。
    Dim TempArray As Variant
        Select Case DimensionNumber
        ' 一次元配列の場合。
            Case 1
                TempArray = source_array
        ' 二次元配列の場合、目的列を抜き出し。
            Case 2
                TempArray = WorksheetFunction.Index(source_array, 0, target_column_index)
        ' 三次元以上は対応しない。
            Case Else
                RemovalDuplicateArray = Array()
        End Select
                      
    ' 重複除去用の辞書（連想配列）
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")
    Dim a As Variant
        For Each a In TempArray
            ' 配列内の各値を、辞書に格納する。
            ' 重複除去が目的のため、itemは不問。今回は「1」とした。
            Dict(a) = 1
        Next
        ' 辞書のkeyが、重複除去後の配列として取り出せる。
        RemovalDuplicateArray = Dict.keys
End Function

それでは、確認してみよう。
↓ の選択範囲のうち、２列目の「キャリア」を抜き出して重複除去する。

Sub ArrayTest()
    Dim arr As Variant
        arr = RemovalDuplicateArray(Selection.Value, 2)
        MsgBox Join(arr, vbNewLine)
End Sub

結果が ↓ こちら。

希望どおりの結果を得ることが出来た。
しかし、実用には未だ足りない。

ということで、明日に続きます。

参考まで。