TextJoin UDF For Excel 2013

前端 未结 4 2102
夕颜
夕颜 2020-12-18 13:17

I am trying to utilize a UDF version of TextJoin since I am using Excel 2013 - but this function is not properly returning the accurate data.

My data-set in Excel lo

相关标签:
4条回答
  • 2020-12-18 13:31

    You may try something like this...

    Function TEXTJOIN(delimiter As String, lookup_id As Range, arr_rng As Range, Optional ignore_empty As Boolean = True) As String
    Dim x, dict
    Dim i As Long
    x = arr_rng.Value
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(x, 1)
        If x(i, 1) = lookup_id Then
            If Not dict.exists(x(i, 1)) Then
                dict.Item(x(i, 1)) = x(i, 2)
            Else
                dict.Item(x(i, 1)) = dict.Item(x(i, 1)) & IIf(x(i, 2) = "", IIf(ignore_empty, "", delimiter), delimiter & x(i, 2))
            End If
        End If
    Next i
    If dict.Count > 0 Then
        TEXTJOIN = dict.Item(IIf(IsNumeric(lookup_id), lookup_id + 0, lookup_id))
    Else
        TEXTJOIN = ""
    End If
    End Function
    

    Then considering your data is in range A2:B7, try this like below...

    In C2

    =TEXTJOIN(",",A2,$A$2:$B$7)
    

    0 讨论(0)
  • 2020-12-18 13:32

    If your data is in columns A and B, this code should work.

    Sub TEXTJOIN()
    Dim i As Long, str As String, k As Long
    Columns("A:B").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlYes
    str = Cells(2, 2)
    k = 2
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1) = Cells(i + 1, 1) Then
            str = str & "," & Cells(i + 1, 2)
        Else
            Cells(k, 4) = Cells(i, 1)
            Cells(k, 5) = str
            k = k + 1
            str = Cells(i + 1, 2)
        End If
    Next i
    End Sub
    

    I leave the part to you to convert this to an UDF.

    0 讨论(0)
  • 2020-12-18 13:36

    Try this....!

    Function TEXTJOIN(delimiter As String, ignore_empty As Boolean, ParamArray 
    cell_ar() As Variant)
    2
    For Each cellrng In cell_ar
    3
    For Each cell In cellrng
    4
    If ignore_empty = False Then
    5
    result = result & cell & delimiter
    6
    Else
    7
    If cell <> "" Then
    8
    result = result & cell & delimiter
    9
    End If
    10
    End If
    11
    Next cell
    12
    Next cellrng
    13
    TEXTJOIN = Left(result, Len(result) - Len(delimiter))
    14
    End Function
    
    0 讨论(0)
  • 2020-12-18 13:39

    This function accepts both ranges and arrays, both horizontal and vertical

    Function TEXTJOIN(delim As String, skipblank As Boolean, arr)
        Dim d As Long
        Dim c As Long
        Dim arr2()
        Dim t As Long, y As Long
        t = -1
        y = -1
        If TypeName(arr) = "Range" Then
            arr2 = arr.Value
        Else
            arr2 = arr
        End If
        On Error Resume Next
        t = UBound(arr2, 2)
        y = UBound(arr2, 1)
        On Error GoTo 0
    
        If t >= 0 And y >= 0 Then
            For c = LBound(arr2, 1) To UBound(arr2, 1)
                For d = LBound(arr2, 1) To UBound(arr2, 2)
                    If arr2(c, d) <> "" Or Not skipblank Then
                        TEXTJOIN = TEXTJOIN & arr2(c, d) & delim
                    End If
                Next d
            Next c
        Else
            For c = LBound(arr2) To UBound(arr2)
                If arr2(c) <> "" Or Not skipblank Then
                    TEXTJOIN = TEXTJOIN & arr2(c) & delim
                End If
            Next c
        End If
        TEXTJOIN = Left(TEXTJOIN, Len(TEXTJOIN) - Len(delim))
    End Function
    

    In this instance you would use it as an array formula:

    =TEXTJOIN(", ",TRUE,IF($A$2:$A$10=D2,$B$2:$B$10,""))
    

    Being an array formula it would need to be confirmed with Ctrl-Shift-Enter instead of Enter when exiting edit mode.

    0 讨论(0)
提交回复
热议问题