配列の重複削除 ③ 範囲やテーブルの任意の一列からも、重複の無い一次元配列を作成してみる

昨日は、二次元配列の任意の一列から、重複の無い一次元配列を作成してみた。
infoment.hatenablog.com

しかし、このままでは未だ足りない。もう少し機能拡張してみよう。

ということで、昨日のものを少し弄ってみた。

1. 配列だけでなく、範囲（Range）またはテーブル（ListObject）も受け取る。
2. 範囲の場合は、「Ｌ列」のようにアルファベットでも指定できるようにする。
   ただし、範囲がＡ列から始まっていない場合は要注意。
3. テーブルの場合は、ラベル名でも指定できるようにする。

コードが、だんだん長くなってきた。
いずれ分割も検討するとして、現状はこんな感じ。

Function RemovalDuplicateArray(ByVal source As Variant, _
                      Optional ByVal target_column_index As Variant = 1) As Variant
                      
    ' 配列確認。
    Dim source_array As Variant

    ' 配列に格納できないものがセットされる場合を想定し、一時的にエラーを無視。
        On Error Resume Next
        
    ' sourceを範囲で指定された場合。
        If TypeName(source) = "Range" Then
        ' 列番号がアルファベットで指定された場合、数値に変換する。
            If IsNumeric(target_column_index) = False Then
                target_column_index = StrConv(target_column_index, vbNarrow + vbUpperCase)
                If target_column_index Like "*[A-Z]*" Then
                    target_column_index = Cells(1, target_column_index).Column
                End If
                source_array = source.Value
            End If
        
    ' sourceがテーブルの場合。
        ElseIf TypeName(source) = "ListObject" Then
            source_array = source.DataBodyRange.Value
        ' 列がラベル名で指定されている場合、列番号に置き換える。
            If IsNumeric(target_column_index) = False Then
                target_column_index = source.ListColumns(target_column_index).Index
            End If
            
    ' sourceが上記以外であって、且つ、配列ではない場合（例えば文字列などの場合）。
        ElseIf IsArray(source) = False Then
            source_array = Array(source)
        End If
    
    ' 上記でエラーが発生していた場合の処理。
        If Err.Number <> 0 Then GoTo er:
    
    ' 配列の次元数を確認。
    Dim i As Long
        For i = 1 To 3
            Debug.Print UBound(source_array, i)
            If Err.Number <> 0 Then Exit For
        Next
        On Error GoTo 0
    
    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
                GoTo er:
        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
        
        Exit Function
er:
    RemovalDuplicateArray = Array()
    On Error GoTo 0
End Function

それではこちら、なんちゃって個人情報を元に作成したテーブルで試してみよう。

都道府県の列から、重複の無い一次元配列を作成する。

Sub ArrayTest()
    Dim arr As Variant
        arr = RemovalDuplicateArray(ActiveSheet.ListObjects(1), "都道府県")
        MsgBox Join(arr, vbNewLine)
End Sub

結果がこちら。

一区切りつくまで、あと少し。次回に続きます。

参考まで。