如何联接以逗号分隔的命名范围中的返回值

时间:2018-07-11 09:55:34

标签: arrays excel excel-vba join named-ranges

我花了数小时试图找出如何联接命名范围内返回的值,但结果是

  

运行时错误32-类型不匹配。

作为一个新手,我仍在努力处理数组,因此也许我忽略了一些细节。谢谢您的帮助。

例如:(B1)汽油,(B2)柴油,(B3)氢化物->(E1)汽油,(E2)柴油,(E3)混合物

这是命名范围:
Named Range: MOTOR

另一个示例(更清晰):

示例2:(B1)汽油,(B3)氢化物->(E1)汽油,(E3)混合物

Named Range: MOTOR

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 个答案:

答案 0 :(得分:3)

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

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

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

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

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

注释

Index函数中的参数0表示不选择特定的行,参数ColNo选择循环中的每一列。随后的 transposition 允许将2维数组的值更改为1维数组。 Join函数需要一个1维数组,并在其中连接所选的列项目。

提示:以下示例代码假定您没有从您的个人宏库中调用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
  

编辑-在任意订单中灵活搜索以翻译已加入的列表

该解决方案允许使用Application.Index函数以行和列数组作为参数,以高级方式使用getSplitters()函数以任何组合返回连接的搜索词。主要功能M仅需三个步骤即可创建一个变量2-dim数组,不带循环和重做,并使用两个语言常量(Const DUTCH和Const ENGLISH)。

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

电话代码

由于您的OP,调用代码会对工作表"ONDERDELEN"中列getSplitters中所有用逗号分隔的字符串进行分析,直到A列中有值为止。这是通过将找到的字符串值传递给主要功能Motor并采用创新的方法,仅需三个步骤即可实现结果,而无需循环(请参见下面的功能代码)。

翻译基于表"B1:E4"中命名范围"Motor" 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 中的值,其中行包含不同种类的燃料,而相邻列则使用不同的语言(第一列以荷兰语开头和英语在第四栏)。

请注意,使用VBA遍历数组以获取值要比通过范围更快。

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

两个助手功能

Motor
  

附录 (由于评论而编辑)

如果您确定并置的搜索词(或起始部分)实际上匹配,则上述代码将按预期工作,否则将引发错误13。您可以分两个步骤解决此问题:

  1. 在您的命名范围?中插入空的第一行(或用#N/AgetNumber()等填充)
  2. 按如下所示更改第二个助手功能:

编辑的功能 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

    firebase.auth().signInWithEmailAndPassword(email, password)
    .then((res) => { 
        console.log(`Login successful: ${JSON.stringify(res)}`)
        //TODO: signin stuff, eg. storing user session credentials?
        this.props.navigation.navigate('MainNav')
    })
    .catch((res) => {
        console.log(`Login was not successful: ${JSON.stringify(res)}`)
        this.setState({signinError: res.message})
    });

答案 1 :(得分:1)

对于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