[Excel]TEXTJOINカスタム関数

ソースコード

下記のコードを全てコピーし、標準モジュール等に貼り付けて下さい。下記のコード表示欄の右上に「Copy」ボタンがありますのでご使用下さい。なお、標準モジュールが何だか分からない方は、 Excelのカスタムワークシート関数を使用する方法 を参照して下さい。

' [Excel]TEXTJOINカスタム関数 
' Copyright (c) 2020-2024  黒箱 
' This software is released under the MIT License;. 
' このソフトウェアはMITライセンスの下でリリースされています。 

'* @fn Public Function TEXTJOIN(ByRef Delimiter As Variant, ByVal IgnoreEmpty As Boolean, ParamArray Params() As Variant) As Variant
'* @brief Excel365・Excel2019のTEXTJOIN関数をExcel2016以前で使用可能にします。
'* @param[in] Delimiter     テキスト文字列、空、または二重引用符で囲まれた1つ以上の文字、または有効なテキスト文字列への参照。 数値を指定すると、文字列として扱われます。
'* @param[in] IgnoreEmpty   TRUE の場合、空のセルは無視されます。
'* @param[in] Params        結合するテキスト項目。 文字列またはセルの範囲などの文字列の配列。最大 252 のテキスト引数を設定できます。
'* @return Variant 結合した文字列。
'* @details TEXTJOIN関数は、複数の範囲や文字列からのテキストを結合し、結合する各テキスト値の間に、指定した区切り記号を挿入します。 区切り記号が空の文字列の場合は、範囲が連結されます。
'*
Public Function TEXTJOIN(ByRef Delimiter As Variant, ByVal IgnoreEmpty As Boolean, ParamArray Params() As Variant) As Variant
    
    Dim v As Variant
    Dim r As Range
    Dim Param As Variant
    Dim ParamType As VbVarType
    Dim Text As String
    
    Dim Row As Long
    Dim Col As Long
    Dim ColsCount As Long
    
    
    For Each Param In Params
        ParamType = VarType(Param)
        
        If (ParamType And vbArray) Then
            
            '参照配列の結合処理
            If (TypeName(Param) = "Range") Then
                Set r = Param
                v = r.Value2
                ColsCount = r.Columns.Count
                
                For Row = 1 To UBound(v)
                    For Col = 1 To ColsCount
                        Text = CStr(v(Row, Col))
                        GoSub Join
                    Next
                Next
            
            '2次元配列定数の結合処理
            ElseIf (True) Then
                
                '配列が一次元なら一次元配列用の処理へ移行
                On Error GoTo LinearArray
                ColsCount = UBound(Param, 2)
                
                For Row = 1 To UBound(Param, 1)
                    For Col = 1 To ColsCount
                        Text = CStr(Param(Row, Col))
                        GoSub Join
                    Next
                Next
            
            '1次元配列定数の結合処理
            Else
LinearArray:
                For Row = 1 To UBound(Param)
                    Text = CStr(Param(Row))
                    GoSub Join
                Next
            End If
        
        '単一参照結合処理
        ElseIf (ParamType = vbObject) Then
            Set r = Param
            Text = CStr(r.Value2)
            GoSub Join
                        
        '定数結合処理
        Else
            Text = CStr(Param)
            GoSub Join
        End If
        
    Next
    
    '先頭の区切り文字削除
    TEXTJOIN = Mid(TEXTJOIN, Len(Delimiter) + 1)
    
    Exit Function

Join:
    If (IgnoreEmpty) Then
        If (Text <> "") Then TEXTJOIN = TEXTJOIN & Delimiter & Text
    Else
        TEXTJOIN = TEXTJOIN & Delimiter & Text
    End If
    
    Return

End Function