TextJoin UDF For Excel 2013

我正在尝试使用一个UDF版本的TextJoin，因为我正在使用Excel 2013 – 但是这个函数没有正确地返回准确的数据。

我在Excel中的数据集看起来像这样

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

而我的期望输出是

 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 

我正在这样的单元格中调用它

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

我得到一个错误#VALUE！

Answer 1

如果你的数据在列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。

Answer 2

你可以尝试这样的事情…

 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

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

Answer 3

这个函数接受水平和垂直的范围和数组

 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 

在这个例子中，你可以使用它作为数组公式：

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

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