arrays - 如何连接以逗号分隔的命名范围的返回值

Question

我花了几个小时试图找出如何连接指定范围内的返回值，但结果是

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

Answer 1

获取命名范围内每列的逗号分隔字符串

我没有分析您的代码，但这应该可以接收加入的前三个值

"Benzine, Diesel, Hybride"  ' e.g. from first column 

或

"Gasoline, Diesel, Hybrid"  ' e.g. from the fourth column

通过 Application.Index 函数从命名范围“Motor”中获取。

注释

此Index函数中的参数0表示不选择特定行，参数ColNo选择循环中的每一列。随后的转置允许将二维数组值更改为一维数组。 Join 函数需要一个一维数组并连接其中选定的列项。

提示:以下示例代码使用完全限定的范围引用，假设您没有从个人宏库调用 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

此解决方案允许使用行和列数组作为参数，以高级方式使用 Application.Index 函数以任何组合返回连接的搜索词。主函数 getSplitters() 仅用三个步骤即可创建一个变体 2-dim 数组，没有循环和 redims，并使用两个语言常量(Const DUTCH 和 Const ENGLISH)。:

1. 将数据分配给基于变体 1 的 2 维数据字段数组
2. 仅获取基于逗号分隔字符串值的选定行
3. 将同一数组缩减为荷兰语和英语列

调用代码

由于您的OP，调用代码会分析工作表“ONDERDELEN”中列M中的所有逗号分隔字符串，只要A列中有值即可。这是通过使用创新方法将这些找到的字符串值传递给主函数getSplitters来实现，只需三个步骤即可获得结果，无需循环(请参阅函数代码如下)。

翻译基于工作表 “Motor” 中命名范围 Motor “B1:E4” 中的值，其中行包含不同类型的与不同语言的相邻列一起加油(从第一列中的荷兰语开始，第四列中的英语)。

请注意，使用 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。您可以通过两个步骤解决此问题:

1. 将空的第一行插入您的命名范围Motor(或填充它，例如使用？，#N/A 等)
2. 按如下方式更改第二个辅助函数:

编辑函数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