Vba TextJoin Excel 2013自定义项

由于我使用的是Excel 2013，所以我尝试使用TextJoin的UDF版本，但此函数无法正确返回准确的数据

我在Excel中的数据集如下所示

saleID      Item
5           PRE2323
6           Pre2323223
6           OX12321
6           RI132
9           TN23
9           LSR12

=TEXTJOIN(", ",1,INDEX(REPT(B$2:B$100,A$2:A$100=ROWS(C$2:C2)),0))

我想要的结果是

saleID     Items
5          Pre2323
6          Pre2323223, OX12321, RI132
9          TN23, LSR12

这是我的UDF，它没有发挥应有的作用

    Option Explicit
Function TEXTJOIN(delimiter As String, ignore_empty As String, ParamArray textn() As Variant) As String
    Dim i As Long
    For i = LBound(textn) To UBound(textn) - 1
        If Len(textn(i)) = 0 Then
            If Not ignore_empty = True Then
                TEXTJOIN = TEXTJOIN & textn(i) & delimiter
            End If
        Else
            TEXTJOIN = TEXTJOIN & textn(i) & delimiter
        End If
    Next
    TEXTJOIN = TEXTJOIN & textn(UBound(textn))
End Function

我在牢房里这样叫它

saleID      Item
5           PRE2323
6           Pre2323223
6           OX12321
6           RI132
9           TN23
9           LSR12

=TEXTJOIN(", ",1,INDEX(REPT(B$2:B$100,A$2:A$100=ROWS(C$2:C2)),0))

---

我得到一个#值的错误

如果您的数据在A列和B列中，则此代码应该可以工作

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

---

我将此部分留给您，以便将其转换为UDF。

您可以尝试类似的方法

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

然后，考虑到您的数据在A2:B7范围内，请尝试以下方式

在C2中

---

此函数同时接受范围和数组（水平和垂直）

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

作为一个数组公式，在退出编辑模式时需要使用Ctrl-Shift-Enter而不是Enter进行确认

试试这个

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

函数TEXTJOIN（分隔符为字符串，忽略\u空为布尔值，参数数组
单元_ar（）作为变量）
2.
对于单元格中的每个单元格
3.
对于cellrng中的每个单元格
4.
如果ignore_empty=False，则
5.
结果=结果、单元格和分隔符
6.
其他的
7.
如果是单元格“”，则
8.
结果=结果、单元格和分隔符
9
如果结束
10
如果结束
11
下一个细胞
12
下一个cellrng
13
TEXTJOIN=Left（结果，Len（结果）-Len（分隔符））
14
端函数

可能是索引有问题formula@GowthamShiva-有关于如何补救的建议吗？这件事让我摸不着头脑。我不完全确定。但我有一个不同的答案，你可以修改。让我知道，如果我可以为你发布，你也可以让你的函数接受范围，以及数组吗？@GowthamShiva-是的，一个不同的解决方案是可行的。我只是想自己做这件事，但却碰上了一堵墙：）我一定错过了什么。我将其更改为一个公共函数TextJoin（），并在单元格D2中输入TextJoin（），但它总是返回0？我在代码中看到的是，您正在比较I，1和I+1，1的值（例如A2和B2），如果值匹配，则在它们之间附加逗号。@如果将其用作自定义项，则可能需要将值返回到相应的范围。不仅仅是在

一个单元格中输入UDF

。您可以像我发布的一样使用它欢迎使用StackOverflow。只有代码的答案往往会被标记为删除，因为它们是“低质量的”。请阅读回答问题的帮助部分，然后考虑给你的答案添加一些评论。