在笛卡尔积中，下标超出范围误差

I'm trying to find the Cartesian product of 4 columns which have data separated by delimiter

我试图找到4列的笛卡尔积,其数据用分隔符分隔

Example

ID                     ID2                         String           String2 
1234   33423,43222,442224,213432    Sample;repeat;example;multiple second; possible;delimiter
2345 12354; 55633; 343534;65443;121121 data;set;sample;find     answer;combination;by

and I get an error Subscript out of range with the below code. Can anyone help with where it is going wrong?

我用下面的代码得到一个错误的下标超出范围。任何人都可以帮助解决它出错的地方吗?

Sub Cartesian()
    Dim MyStr1 As Variant, MyStr2 As Variant, MyStr3 As Variant, MyStr4 As Variant, _
    Str1 As Variant, Str2 As Variant, Str3 As Variant, Str4 As Variant, X As Long, _
    OrigString1 As Variant, OrigString2 As Variant, OrigString3 As Variant, _
    OrigString4 As Variant, Y As Long

    OrigString1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    OrigString2 = Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)
    OrigString3 = Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
    OrigString4 = Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)

    X = 2

    For Y = LBound(OrigString1) To UBound(OrigString1)

        MyStr1 = Split(OrigString1(Y), ";")
        MyStr2 = Split(OrigString2(Y), ";")
        MyStr3 = Split(OrigString3(Y), ";")
        MyStr4 = Split(OrigString4(Y), ";")

        For Each Str1 In MyStr1
            For Each Str2 In MyStr2
                For Each Str3 In MyStr3
                    For Each Str4 In MyStr4
                        Range("A" & X).Formula = Str1
                        Range("B" & X).Formula = Str2
                        Range("C" & X).Formula = Str3
                        Range("D" & X).Formula = Str4
                        X = X + 1
                    Next
                Next
            Next
        Next

    Next
End Sub

Or is there a better way to deal with this using sql? Or any better way to achieve the Cartesian product of every row using VBA?

或者有没有更好的方法来处理这个使用SQL?或者使用VBA实现每一行笛卡尔积的更好方法?

3 个解决方案

#1

Something like this works. I could not find a more elegant solution.

像这样的东西有效。我找不到更优雅的解决方案。

Sub Cartesian()
    Dim MyStr1() As String
    Dim MyStr2() As String
    Dim MyStr3() As String
    Dim MyStr4() As String
    Dim X As Long
    Dim OrigString1() As String
    Dim OrigString2() As String
    Dim OrigString3() As String
    Dim OrigString4() As String
    Dim Y As Long

    Dim sht As Worksheet
    Set sht = Worksheets("Sheet1")

    ReDim OrigString1(1 To Range("A" & Rows.Count).End(xlUp).Row - 1)

    For Y = 1 To UBound(OrigString1)
        OrigString1(Y) = CStr(Range("A" & CStr(Y + 1)).Value)
    Next

    ReDim OrigString2(1 To Range("B" & Rows.Count).End(xlUp).Row - 1)

    For Y = 1 To UBound(OrigString2)
        OrigString2(Y) = CStr(Range("B" & CStr(Y + 1)).Value)
    Next

    ReDim OrigString3(1 To Range("C" & Rows.Count).End(xlUp).Row - 1)

    For Y = 1 To UBound(OrigString3)
        OrigString3(Y) = CStr(Range("C" & CStr(Y + 1)).Value)
    Next

    ReDim OrigString4(1 To Range("D" & Rows.Count).End(xlUp).Row - 1)

    For Y = 1 To UBound(OrigString4)
        OrigString4(Y) = CStr(Range("D" & CStr(Y + 1)).Value)
    Next

    X = 2

    For Y = LBound(OrigString1) To UBound(OrigString1)

        MyStr1() = Split(OrigString1(Y), ";")
        MyStr2() = Split(OrigString2(Y), ";")
        MyStr3() = Split(OrigString3(Y), ";")
        MyStr4() = Split(OrigString4(Y), ";")

        For Each Str1 In MyStr1
            For Each Str2 In MyStr2
                For Each Str3 In MyStr3
                    For Each Str4 In MyStr4
                        Range("A" & X).Formula = Str1
                        Range("B" & X).Formula = Str2
                        Range("C" & X).Formula = Str3
                        Range("D" & X).Formula = Str4
                        X = X + 1
                    Next
                Next
            Next
        Next
    Next
End Sub

#2

The first row contains commas and not semi-colons, that is messing up the dimensionality of the vector

第一行包含逗号而不是分号,这会弄乱向量的维数

#3

When you are stuffing a block of cells' values into a variant array it is best not to rely upon the default property being .Value. Explicitly state that you want the value from the cells. In fact, use .Value2 to get the base values from the cells.

当您将一个单元格的值填充到变量数组中时,最好不要依赖默认属性.Value。明确声明您需要来自单元格的值。实际上,使用.Value2从单元格中获取基值。

OrigString1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value2
OrigString2 = Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value2
OrigString3 = Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value2
OrigString4 = Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row).Value2

See Range.Value2 Property for more information on .Value2. Specific minor properties of Currency and Date value types are not important when trying to bulk process in memory; only when the raw values get passed back to the worksheet.

有关.Value2的更多信息,请参见Range.Value2属性。尝试在内存中批量处理时,Currency和Date值类型的特定次要属性并不重要;仅当原始值传递回工作表时。

#1