関数を作る_3（VBA研究会議事録_14）

VBA研究会で論じられた内容を記録する議事録の14本目（2023/05/06開催分）です。前回の議事録はコチラになります。

hirocom777.hatenadiary.org

Office365などに搭載されていて、それより前のExcelに搭載されていないワークシート関数を作ってみようという企画に取り組んでいます。

前回までは数値データを取り込む方法を考えてきました。今回は文字データとテーブルを対象にしてみようと思います。

テーブルからの取得

それでは今回のお題です。

テーブル名と列名を引数として受けて、以下の処理を行うFunctionプロシージャを作成してください。テーブルのデータはすべて文字列とします。以下の感じになります。

特定の条件に一致した文字列を抜き出す
一意化する
結果は次の形式で選択できるものとする。1次元配列（デフォルト）、n行1列、1行n列
条件は次の形式を選択できるものとする。完全一致（デフォルト）、部分一致

実際のコード

それでは実際のコードです。

'テーブルの選択列を条件指定して1次元配列にする
Function columnToArray(ByVal tableName As String, _
                        ByVal columnName As String, _
                        Optional ByVal condition As String, _
                        Optional ByVal partialMatch As Boolean = False, _
                        Optional ByVal transferType As Long) _
                        As Variant

    Dim tarTable As ListObject: Set tarTable = Me.ListObjects(tableName)
    Dim tarColumn As ListColumn: Set tarColumn = tarTable.ListColumns(columnName)
    Dim tarArr As Variant: tarArr = WorksheetFunction.Transpose(tarColumn.DataBodyRange.Value)
    Dim dic As New Dictionary
    
    '部分一致、全体一致で絞込
    Dim tarVal As Variant
    For Each tarVal In tarArr
        If Not dic.Exists(tarVal) Then
            If partialMatch = True Then '部分一致
                If CStr(tarVal) Like "*" & condition & "*" Then
                    dic.Add tarVal, Null
                End If
            Else '全体一致
                If tarVal = condition Then
                    dic.Add tarVal, Null
                End If
            End If
        End If
    Next
   
    '指定がある場合は2次元配列に変換
    Dim tmpArr As Variant
    tmpArr = dic.Keys
    If transferType = xlRows Then 'n行1列に変換する
        tmpArr = transferNrow1Column(tmpArr)
    ElseIf transferType = xlColumns Then '1行n列に変換する
        tmpArr = transfer1rowNColumn(tmpArr)
    End If
        
    columnToArray = tmpArr

End Function

テーブルから指定列の範囲を取得したのちに、ワークシート関数のTransposeを使用して配列に変換しています。文字の部分一致で値を取り出す場合はLike演算子を使用、全体一致の場合は単純に比較して取りだした値を重複しないように辞書型に登録します。最後に辞書のキー要素を配列にコピー、必要に応じて2次元配列に変換します。変換については以下のFunctionプロシージャを使用します。

'n行1列に変換する
Function transferNrow1Column(ByVal tarArr As Variant) As Variant()
    
    transferNrow1Column = WorksheetFunction.Transpose(tarArr)

End Function

'1行n列に変換する
Function transfer1rowNColumn(ByVal tarArr As Variant) As Variant
    
    ReDim tmpArr(0, 0 To UBound(tarArr))
    Dim i As Long
    For i = LBound(tarArr) To UBound(tarArr)
        tmpArr(0, i) = tarArr(i)
    Next i
    transfer1rowNColumn = tmpArr

End Function

使用例

今回作成した「columnToArray」の使用例です。以下は指定したテーブルの列から値を取り出して、指定した表示先に縦or横方向に表示します。

以下は取得した内容を縦に表示する例です。

Sub Sample_1()

    Dim sampleData As Variant
    sampleData = columnToArray(テーブル名, 列名, 条件文字列, True, xlColumns)
    表示先.Resize(1, UBound(sampleData, 2) + 1).Value = sampleData

End Sub

横方向に表示する場合には、以下のようになります。

Sub Sample21()

    Dim sampleData As Variant
    sampleData = columnToArray(テーブル名, 列名, 条件文字列, True, xlRows)
    表示先.Resize(UBound(sampleData, 1), 1).Value = sampleData

End Sub

縦方向と横方向では配列の扱い方が微妙に違うので、注意が必要ですね。