Excel 2013 的 TextJoin UDF
TextJoin UDF For Excel 2013
我正在尝试使用 TextJoin 的 UDF 版本,因为我使用的是 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:B0,A:A0=ROWS(C:C2)),0))
我收到错误 #VALUE!
如果您的数据在 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
=TEXTJOIN(",",A2,$A:$B)
此函数接受水平和垂直范围和数组
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:$A=D2,$B:$B,""))
作为数组公式,退出编辑模式时需要使用 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 的 UDF 版本,因为我使用的是 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:B0,A:A0=ROWS(C:C2)),0))
我收到错误 #VALUE!
如果您的数据在 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
=TEXTJOIN(",",A2,$A:$B)
此函数接受水平和垂直范围和数组
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:$A=D2,$B:$B,""))
作为数组公式,退出编辑模式时需要使用 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