配列の重複削除 ④ 重複の無い一次元配列を作成するクラスモジュール

先日来、二次元配列の任意の一列から、重複の無い一次元配列作成を試みている。
infoment.hatenablog.com

今日は最終回。以前作成したクラスモジュールに、先日作成したユーザー定義関数を含めてみる。
f:id:Infoment:20200719092452p:plain

今回行ったのは、以下の三つ。

以前作成したクラスモジュール「Seaquence」に、今回のユーザー定義関数を
含めてみる。
配列の次元数取得は同クラスモジュール内に実装済みのため、今回の関数から除外する。
「空白は除去する」など、細かい調整を行う。

それでは今回行った編集の内、関係する部分だけを紹介する。

クラスモジュール（Seaquence）

'   配列の次元数取得
Private Function GetArrayDimension(arr As Variant) As Long
    
    If IsArray(arr) = False Then
        GetArrayDimension = -1
        Exit Function
    End If
    
    ' 配列の次元数を取得。
    
    Dim i As Long
    Dim TempNumber As Long
        
        On Error Resume Next
        Do While Err.Number = 0
            i = i + 1
            TempNumber = UBound(arr, i)
        Loop
        
        GetArrayDimension = i - 1

End Function

' 配列、範囲、テーブルから重複の無い一次元配列を作成。
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) Then
            source_array = source

    ' sourceが上記以外の場合（例えば文字列などの場合）。
        Else
            source_array = Array(source)
        End If
    
    ' 上記でエラーが発生していた場合の処理。
        If Err.Number <> 0 Then
            GoTo er:
        Else
            On Error GoTo 0
        End If
    
    ' 配列の次元数を確認。
    Dim DimensionNumber As Long
        DimensionNumber = GetArrayDimension(source_array)
    
    ' 作業用配列。
    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」とした。
            ' ※空欄はリストに含めない。
            If a <> vbNullString Then
                Dict(a) = 1
            End If
        Next
        ' 辞書のkeyが、重複除去後の配列として取り出せる。
        RemovalDuplicateArray = Dict.Keys
        
        Exit Function
er:
    RemovalDuplicateArray = Array()
    On Error GoTo 0
End Function

標準モジュール

テスト用マクロがこちら。
題材は前回と同様、なんちゃって個人情報（テーブル化済み）だ。
f:id:Infoment:20200719093242p:plain

Sub ArrayTest()
    Dim arr As Variant
        With New Seaquence
            arr = .RemovalDuplicateArray(source:=ActiveSheet.ListObjects(1), _
                                         target_column_index:="都道府県")
            MsgBox Join(arr, vbNewLine)
        End With
End Sub