将数组拆分为多个数组/ bin

时间:2017-06-02 00:24:10

标签: excel-vba vba excel

我有一个字符串数组 - 称之为Xarray。我有三个其他的字符串数组--Aarray,Barray和Carray。 Xarray可能有一个很小的长度 - 比如3或4. A,B和C数组通常是一个较长的主列表(比如每个10+元素)。

Xarray只包含在Aarray,Barray或Carray中找到的元素。

我需要将Xarray分成3个分区/数组 - 称之为XA,XB和XC。 XA应该只包含Aarray中的Xarray条目。 XB应该只包含在Barray中找到的Xarray条目。 XC应该......你得到了照片。

这样做的好方法是什么?感谢您的帮助。

1 个答案:

答案 0 :(得分:0)

假设你的字符串数组是一维的,这会有用吗?

Sub ArraySlicing()

    Dim Xarray() As String
    Dim Aarray() As String, Barray() As String, Carray() As String
    Dim XA() As String, XB() As String, XC() As String
    Dim XA_RwIndexList As String, XB_RwIndexList As String, XC_RwIndexlist As String
    Dim i As Long

    'create test data arrays
    Xarray = Split("Red,Blue,Green,Yellow,Orange,Lime,Purple,Turquoise,Pink,Brown,White,Black,Gold", ",")
    Aarray = Split("Apple,Orange,Banana,Lime,Pear,Orange,Green Apple,Red Apple", ",")
    Barray = Split("Pink Rose,Tulip,Daisy,Bluebell,Carnation,Marigold", ",")
    Carray = Split("redwood,spruce,lime,pine,oak,lemon,chestnut,walnut,orange", ",")

    'loop XArray and check for matches
    For i = LBound(Xarray) To UBound(Xarray)

        'note application.match is case insensitive and will only match complete words
        'i.e. "orange" & "Orange" will be found, "Pink Rose" will not

        If Not IsError(Application.Match(Xarray(i), Aarray, 0)) Then _
        XA_RwIndexList = XA_RwIndexList & "_" & i 'index matching rows

        If Not IsError(Application.Match(Xarray(i), Barray, 0)) Then _
        XB_RwIndexList = XB_RwIndexList & "_" & i 'index matching rows

        If Not IsError(Application.Match(Xarray(i), Carray, 0)) Then _
        XC_RwIndexlist = XC_RwIndexlist & "_" & i 'index matching rows

    Next i

    'check if XA_RwIndexList was initialized i.e. there were matches
    If Not XA_RwIndexList = vbNullString Then

        'trim preceeding "_" & store row #s in XA array
        XA = Split(Mid(XA_RwIndexList, 2), "_")

        'loop XA and replace row # with corresponding values from XArray
        For i = LBound(XA) To UBound(XA)
            XA(i) = Xarray(XA(i))
        Next i

    End If

    'check if XB_RwIndexList was initialized i.e. there were matches
    If Not XB_RwIndexList = vbNullString Then

        'trim preceeding "_" & store row #s in XB array
        XB = Split(Mid(XB_RwIndexList, 2), "_")

        'loop XB and replace row # with corresponding values from XArray
        For i = LBound(XB) To UBound(XB)

            XB(i) = Xarray(XB(i))

        Next i

    End If

    'check if XC_RwIndexList was initialized i.e. there were matches
    If Not XC_RwIndexlist = vbNullString Then

        'trim preceeding "_" & store row #s in XC array
        XC = Split(Mid(XC_RwIndexlist, 2), "_")

        'loop XC and replace row # with corresponding values from XArray
        For i = LBound(XC) To UBound(XC)

            XC(i) = Xarray(XC(i))

        Next i

    End If

End Sub

根据您的字符串匹配要求Application.Match可能不是最合适的,但我认为我建议它,因为这是避免需要循环其他3个数组的好方法。