如何连接以逗号分隔的命名范围的返回值
How to join returned values from named range separated by comma
我花了几个小时试图找出如何连接命名范围的返回值，但结果是
run-time error 32 - Type mismatch.
作为一个新手，我还在为数组苦苦挣扎，所以我可能忽略了一些细节。谢谢你帮我。
示例：(B1)汽油、(B2)柴油、(B3)混合动力 -> (E1)汽油、(E2)柴油、(E3)混合动力
这是命名范围：
再举个例子（更清楚）：
示例 2：(B1)汽油，(B3)混合动力 -> (E1)汽油，(E3)混合动力
Option Explicit
Sub splitter()
Dim i As Long
Dim w As Long
'Dim oWB As Workbook
Dim oWS As Worksheet
Dim oWS9 As Worksheet
Dim rngMOTOR As Range
Dim rngMOTOR2 As Range
Dim arrMOTOR() As Variant
Dim LastRow As Long
'Set oWB = Workbooks("BRONBESTAND.xlsm")
Set oWS = Sheets("ONDERDELEN")
Set oWS9 = Sheets("MOTOR") '5 columns: 1 Short & LONG + 1 NL + 3 Languages !!!!! WARNING
LastRow = oWS.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow 'Starting below headers
Set rngMOTOR = oWS.Cells(i, "M") 'MOTOR ...
Set rngMOTOR2 = oWS9.Range("MOTOR") 'MOTOR2: MOTOR - Bronbestand arrPOS = rngPOS2.Value
arrMOTOR = rngMOTOR2.Value
'*********
Dim txt As String
Dim j As Integer
Dim Splitted As Variant
Dim arrMOTORall As Variant
Dim arrMOTORsplit As Variant
Dim Motor3 As String
txt = oWS.Cells(i, "M") 'MOTOR ...
Debug.Print ("txt : ") & i & ": "; txt
If Not IsEmpty(txt) Then
Splitted = Split(txt, ", ")
For j = 0 To UBound(Splitted)
Cells(1, j + 1).Value = Splitted(j)
Debug.Print (" ---> Splitted: ") & Splitted(j)
'**** INSERT *****
For w = LBound(arrMOTOR) To UBound(arrMOTOR)
If arrMOTOR(w, 1) = Splitted(j) Then 'EX: B - Benzine
arrMOTORsplit = (arrMOTOR(w, 4)) '(arrMOTOR(y, 2)) -> 1=SHORT+LONG , 2=NL, 3=FR, 4=EN
Debug.Print (" ---> arrMOTORsplit: ") & i & ": " & arrMOTORsplit
'**** JOIN ****
arrMOTORall = Join(arrMOTORsplit, ", ")
Debug.Print ("arrMOTORall: ") & arrMOTORall
End If
Next w
Next j
End If
Next i
End Sub
对于 2 个数组，这是一个可能的解决方案：
Sub TestMe()
Dim inputString As String
Dim arrString As Variant
Dim arrResult As Variant
inputString = "Benzine, Diesel, Hybride"
arrString = Split(inputString, ",")
Dim total As Long: total = UBound(arrString)
ReDim arrResult(total)
Dim i As Long
For i = LBound(arrString) To UBound(arrString)
arrResult(total - i) = Trim(arrString(i))
Next i
Debug.Print Join(arrResult, " ,")
End Sub
然而，这个问题有一个经典的解决方案，将所有东西颠倒两次：
Sub TestMe()
Dim inputString As String
inputString = "Benzine, Diesel, Hybride"
inputString = StrReverse(inputString)
Dim arr As Variant: arr = Split(inputString, ",")
Dim i As Long
For i = LBound(arr) To UBound(arr)
arr(i) = Trim(StrReverse(arr(i)))
Next i
Debug.Print Join(arr, ", ")
End Sub
为命名范围内的每一列获取逗号分隔的字符串
我没有分析你的代码，但这应该可以接收前三个加入的值
"Benzine, Diesel, Hybride" ' e.g. from first column
或
"Gasoline, Diesel, Hybrid" ' e.g. from the fourth column
通过 Application.Index 函数从命名范围 "Motor"。
备注
此Index函数中的参数0表示不选择特定行，参数ColNo选择循环中的每一列。随后的 转置 允许将二维数组值更改为一维数组。 Join 函数需要一个 1-dim 数组并连接其中选定的列项。
提示：以下示例代码使用完全限定的范围引用，假设您不从 个人宏调用 TestMe 过程图书馆。在后一种情况下，您必须更改引用和工作簿标识（不使用 ThisWorkbook！）。
示例代码
Option Explicit ' declaration head of your code module
Sub TestMe()
Dim v As Variant, ColNo As Long
' assign first three rows to variant 1-based 2-dim datafield array
v = ThisWorkbook.Worksheets("Motor").[Motor].Resize(3, 4) ' Named range value
' write comma separated list for each column
For ColNo = 1 To 4
Debug.Print Join(Application.Transpose(Application.Index(v, 0, ColNo)), ", ")
Next ColNo
End Sub
EDIT - Flexible Search in ANY ORDER to translate joined lists
此解决方案允许 return 在 任何组合中加入搜索词 使用 Application.Index 函数以高级方式使用行和列数组作为参数。主函数 getSplitters() 仅用三个步骤 创建了一个变体 2-dim 数组，没有循环和 redims 并使用了两个语言常量（Const DUTCH 和 Const ENGLISH）。:
- 将数据分配给基于变量 1 的 2 维数据字段数组
- 根据逗号分隔的字符串值仅获取选定的行
- 将同一数组缩减为荷兰语和英语列
调用代码
由于您的 OP，调用代码分析了您 sheet "ONDERDELEN" 中第 M 列中的所有逗号分隔字符串，只要 A 列中有值。这是由使用 创新方法 将这些找到的字符串值传递给主函数 getSplitters 以在 没有循环的情况下仅三步获得结果 （参见函数下面的代码）。
翻译基于 Motor "B1:E4" in sheet "Motor" 中的命名范围内的值，其中行包含不同类型的燃料，相邻列用于不同的语言（开始第一列为荷兰语，第四列为英语）。
请注意，使用 VBA 循环遍历数组以获取值比循环遍历范围更快。
Option Explicit ' declaration head of your code module
Const DUTCH As Integer = 1
Const ENGLISH As Integer = 4
Sub TranslateAnyFuelCombination()
' Purpose: returns comma separated lists in column "M" and translates from Dutch to English
' Example: "Benzine, Hybride, Diesel" (Dutch) gets to "Gasoline, Hybrid, Diesel" in English
Dim s As String
Dim oWS As Worksheet, i&, LastRow&, vMOTOR As Variant
Set oWS = Thisworkbook.Worksheets("ONDERDELEN") ' fully qualified reference
' Get last row of wanted data
LastRow = oWS.Range("A" & Rows.Count).End(xlUp).Row
vMOTOR = oWS.Range("M1:M" & LastRow)
For i = 2 To LastRow 'Starting below headers
Debug.Print getSplitters(vMOTOR(i, 1))
Next i
End Sub
主要功能
Function getSplitters(ByVal sRows As String) As String
Dim i As Long, j As Long
Dim v As Variant, a As Variant
' [0] analyze selected rows string, e.g. "Benzine, Hybride, Diesel"
a = getRowAr(sRows) ' -> assign 1-dim Rows Array(1, 3, 2)
' [1] assign data to variant 1-based 2-dim datafield array
v = Application.Transpose(ThisWorkbook.Worksheets("Motor").[Motor]) ' Named range value
' [2] get only selected rows, e.g. 1st, 3rd and 2nd -> in free order (!) Benzine, Hybride, Diesel
v = Application.Transpose(Application.Index(v, _
Application.Evaluate("row(1:" & UBound(v, 2) & ")"), _
a)) ' transposed columns array = selected rows
' [3] reduce to Dutch and English columns
v = Application.Transpose(Application.Index(v, _
Application.Evaluate("row(1:" & (UBound(a) + 1) & ")"), _
Array(DUTCH, ENGLISH))) ' selected columns array (above array retransposed)
' [4] return concatenated strings
getSplitters = Join(Application.Transpose(Application.Transpose(Application.Index(v, 1, 0))), ", ") & " -> " & _
Join(Application.Transpose(Application.Transpose(Application.Index(v, 2, 0))), ", ")
End Function
两个辅助函数
Function getRowAr(ByVal sList As String) As Variant
' Purpose: split comma separated list into 1-dim number array in FREE ORDER
' Example: "Benzine, Hybride, Diesel" -> Array(1, 3, 2)
Dim ar, i&
' change words in comma separated list to numbers
ar = Split(Replace(sList, " ", ""), ",")
For i = LBound(ar) To UBound(ar)
ar(i) = val(getNumber(ar(i))) ' change to numbers
Next i
getRowAr = ar ' return
End Function
Function getNumber(ByVal s As String) As Long
' Purpose: replaces dutch search words with corresponding row number
Dim arFuel
' get search words to 1-dim array
arFuel = Application.Index(ThisWorkbook.Worksheets("Motor").[Motor], 0, DUTCH)
' return corresponding number
getNumber = Application.Match(s, arFuel)
End Function
Addendum (Edit due to comment)
如果您确定连接的搜索词（或起始部分）实际匹配，则上述代码将按预期工作，否则会引发错误 13。您可以分两步解决这个问题：
- 将 空第一行 插入到您命名的范围
Motor 中（或用 ?、#N/A 等填充它）
- 修改第二个辅助函数如下：
编辑函数getNumber()
Function getNumber(ByVal s As String) As Long
' Purpose: replaces dutch search words with corresponding row number
Dim arFuel
' get search words to 1-dim array
arFuel = Application.Index(ThisWorkbook.Worksheets("Motor").[Motor], 0, DUTCH)
' return corresponding number
On Error Resume Next ' provide for not found case
getNumber = Application.Match(s, arFuel, 0) ' find only exact matches
If Err.Number <> 0 Then getNumber = 0 ' could be omitted in case of a zero return
End Function
我花了几个小时试图找出如何连接命名范围的返回值，但结果是
run-time error 32 - Type mismatch.
作为一个新手，我还在为数组苦苦挣扎，所以我可能忽略了一些细节。谢谢你帮我。
示例：(B1)汽油、(B2)柴油、(B3)混合动力 -> (E1)汽油、(E2)柴油、(E3)混合动力
这是命名范围：
再举个例子（更清楚）：
示例 2：(B1)汽油，(B3)混合动力 -> (E1)汽油，(E3)混合动力
Option Explicit
Sub splitter()
Dim i As Long
Dim w As Long
'Dim oWB As Workbook
Dim oWS As Worksheet
Dim oWS9 As Worksheet
Dim rngMOTOR As Range
Dim rngMOTOR2 As Range
Dim arrMOTOR() As Variant
Dim LastRow As Long
'Set oWB = Workbooks("BRONBESTAND.xlsm")
Set oWS = Sheets("ONDERDELEN")
Set oWS9 = Sheets("MOTOR") '5 columns: 1 Short & LONG + 1 NL + 3 Languages !!!!! WARNING
LastRow = oWS.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow 'Starting below headers
Set rngMOTOR = oWS.Cells(i, "M") 'MOTOR ...
Set rngMOTOR2 = oWS9.Range("MOTOR") 'MOTOR2: MOTOR - Bronbestand arrPOS = rngPOS2.Value
arrMOTOR = rngMOTOR2.Value
'*********
Dim txt As String
Dim j As Integer
Dim Splitted As Variant
Dim arrMOTORall As Variant
Dim arrMOTORsplit As Variant
Dim Motor3 As String
txt = oWS.Cells(i, "M") 'MOTOR ...
Debug.Print ("txt : ") & i & ": "; txt
If Not IsEmpty(txt) Then
Splitted = Split(txt, ", ")
For j = 0 To UBound(Splitted)
Cells(1, j + 1).Value = Splitted(j)
Debug.Print (" ---> Splitted: ") & Splitted(j)
'**** INSERT *****
For w = LBound(arrMOTOR) To UBound(arrMOTOR)
If arrMOTOR(w, 1) = Splitted(j) Then 'EX: B - Benzine
arrMOTORsplit = (arrMOTOR(w, 4)) '(arrMOTOR(y, 2)) -> 1=SHORT+LONG , 2=NL, 3=FR, 4=EN
Debug.Print (" ---> arrMOTORsplit: ") & i & ": " & arrMOTORsplit
'**** JOIN ****
arrMOTORall = Join(arrMOTORsplit, ", ")
Debug.Print ("arrMOTORall: ") & arrMOTORall
End If
Next w
Next j
End If
Next i
End Sub
对于 2 个数组，这是一个可能的解决方案：
Sub TestMe()
Dim inputString As String
Dim arrString As Variant
Dim arrResult As Variant
inputString = "Benzine, Diesel, Hybride"
arrString = Split(inputString, ",")
Dim total As Long: total = UBound(arrString)
ReDim arrResult(total)
Dim i As Long
For i = LBound(arrString) To UBound(arrString)
arrResult(total - i) = Trim(arrString(i))
Next i
Debug.Print Join(arrResult, " ,")
End Sub
然而，这个问题有一个经典的解决方案，将所有东西颠倒两次：
Sub TestMe()
Dim inputString As String
inputString = "Benzine, Diesel, Hybride"
inputString = StrReverse(inputString)
Dim arr As Variant: arr = Split(inputString, ",")
Dim i As Long
For i = LBound(arr) To UBound(arr)
arr(i) = Trim(StrReverse(arr(i)))
Next i
Debug.Print Join(arr, ", ")
End Sub
为命名范围内的每一列获取逗号分隔的字符串
我没有分析你的代码，但这应该可以接收前三个加入的值
"Benzine, Diesel, Hybride" ' e.g. from first column
或
"Gasoline, Diesel, Hybrid" ' e.g. from the fourth column
通过 Application.Index 函数从命名范围 "Motor"。
备注
此Index函数中的参数0表示不选择特定行，参数ColNo选择循环中的每一列。随后的 转置 允许将二维数组值更改为一维数组。 Join 函数需要一个 1-dim 数组并连接其中选定的列项。
提示：以下示例代码使用完全限定的范围引用，假设您不从 个人宏调用 TestMe 过程图书馆。在后一种情况下，您必须更改引用和工作簿标识（不使用 ThisWorkbook！）。
示例代码
Option Explicit ' declaration head of your code module
Sub TestMe()
Dim v As Variant, ColNo As Long
' assign first three rows to variant 1-based 2-dim datafield array
v = ThisWorkbook.Worksheets("Motor").[Motor].Resize(3, 4) ' Named range value
' write comma separated list for each column
For ColNo = 1 To 4
Debug.Print Join(Application.Transpose(Application.Index(v, 0, ColNo)), ", ")
Next ColNo
End Sub
EDIT - Flexible Search in ANY ORDER to translate joined lists
此解决方案允许 return 在 任何组合中加入搜索词 使用 Application.Index 函数以高级方式使用行和列数组作为参数。主函数 getSplitters() 仅用三个步骤 创建了一个变体 2-dim 数组，没有循环和 redims 并使用了两个语言常量（Const DUTCH 和 Const ENGLISH）。:
- 将数据分配给基于变量 1 的 2 维数据字段数组
- 根据逗号分隔的字符串值仅获取选定的行
- 将同一数组缩减为荷兰语和英语列
调用代码
由于您的 OP，调用代码分析了您 sheet "ONDERDELEN" 中第 M 列中的所有逗号分隔字符串，只要 A 列中有值。这是由使用 创新方法 将这些找到的字符串值传递给主函数 getSplitters 以在 没有循环的情况下仅三步获得结果 （参见函数下面的代码）。
翻译基于 Motor "B1:E4" in sheet "Motor" 中的命名范围内的值，其中行包含不同类型的燃料，相邻列用于不同的语言（开始第一列为荷兰语，第四列为英语）。
请注意，使用 VBA 循环遍历数组以获取值比循环遍历范围更快。
Option Explicit ' declaration head of your code module
Const DUTCH As Integer = 1
Const ENGLISH As Integer = 4
Sub TranslateAnyFuelCombination()
' Purpose: returns comma separated lists in column "M" and translates from Dutch to English
' Example: "Benzine, Hybride, Diesel" (Dutch) gets to "Gasoline, Hybrid, Diesel" in English
Dim s As String
Dim oWS As Worksheet, i&, LastRow&, vMOTOR As Variant
Set oWS = Thisworkbook.Worksheets("ONDERDELEN") ' fully qualified reference
' Get last row of wanted data
LastRow = oWS.Range("A" & Rows.Count).End(xlUp).Row
vMOTOR = oWS.Range("M1:M" & LastRow)
For i = 2 To LastRow 'Starting below headers
Debug.Print getSplitters(vMOTOR(i, 1))
Next i
End Sub
主要功能
Function getSplitters(ByVal sRows As String) As String
Dim i As Long, j As Long
Dim v As Variant, a As Variant
' [0] analyze selected rows string, e.g. "Benzine, Hybride, Diesel"
a = getRowAr(sRows) ' -> assign 1-dim Rows Array(1, 3, 2)
' [1] assign data to variant 1-based 2-dim datafield array
v = Application.Transpose(ThisWorkbook.Worksheets("Motor").[Motor]) ' Named range value
' [2] get only selected rows, e.g. 1st, 3rd and 2nd -> in free order (!) Benzine, Hybride, Diesel
v = Application.Transpose(Application.Index(v, _
Application.Evaluate("row(1:" & UBound(v, 2) & ")"), _
a)) ' transposed columns array = selected rows
' [3] reduce to Dutch and English columns
v = Application.Transpose(Application.Index(v, _
Application.Evaluate("row(1:" & (UBound(a) + 1) & ")"), _
Array(DUTCH, ENGLISH))) ' selected columns array (above array retransposed)
' [4] return concatenated strings
getSplitters = Join(Application.Transpose(Application.Transpose(Application.Index(v, 1, 0))), ", ") & " -> " & _
Join(Application.Transpose(Application.Transpose(Application.Index(v, 2, 0))), ", ")
End Function
两个辅助函数
Function getRowAr(ByVal sList As String) As Variant
' Purpose: split comma separated list into 1-dim number array in FREE ORDER
' Example: "Benzine, Hybride, Diesel" -> Array(1, 3, 2)
Dim ar, i&
' change words in comma separated list to numbers
ar = Split(Replace(sList, " ", ""), ",")
For i = LBound(ar) To UBound(ar)
ar(i) = val(getNumber(ar(i))) ' change to numbers
Next i
getRowAr = ar ' return
End Function
Function getNumber(ByVal s As String) As Long
' Purpose: replaces dutch search words with corresponding row number
Dim arFuel
' get search words to 1-dim array
arFuel = Application.Index(ThisWorkbook.Worksheets("Motor").[Motor], 0, DUTCH)
' return corresponding number
getNumber = Application.Match(s, arFuel)
End Function
Addendum (Edit due to comment)
如果您确定连接的搜索词（或起始部分）实际匹配，则上述代码将按预期工作，否则会引发错误 13。您可以分两步解决这个问题：
- 将 空第一行 插入到您命名的范围
Motor中（或用?、#N/A等填充它） - 修改第二个辅助函数如下：
编辑函数getNumber()
Function getNumber(ByVal s As String) As Long
' Purpose: replaces dutch search words with corresponding row number
Dim arFuel
' get search words to 1-dim array
arFuel = Application.Index(ThisWorkbook.Worksheets("Motor").[Motor], 0, DUTCH)
' return corresponding number
On Error Resume Next ' provide for not found case
getNumber = Application.Match(s, arFuel, 0) ' find only exact matches
If Err.Number <> 0 Then getNumber = 0 ' could be omitted in case of a zero return
End Function