Excel VBA代码 - 具有限制的组合

Question

我必须生成一个组合列表，这些组合是字段的指示符，因为我试图产生一些询问数据的条件。我有一些代码来自here。

在Power {Torque / Cylinders的示例中，结合了1,2,4：

我需要弄清楚这3个字段的组合，因此输出将是：

基本上所有的组合，但不是来自相同的桶＃39;如果这有意义吗？

编辑： 组合的数量（即示例中的3）将根据我提供的链接而改变。链接的组合确定要查看或使用的字段。例如，组合123将是图像中的前3个字段。组合1,2将首先是2，而1,3将是第一个和最后一个。我有代码。

现在我们有了组合桶，需要处理这些领域的组合。

此外，我正在寻找有关如何接近算法的指导，而不一定是有人为我做这件事

另一个例子，如果1,2,3是列组合，则预期输出为：

20-0.5-200

20-0.5-300

20-0.5-400

等

Answer 1

嵌套循环：

Sub allCombo(set1 As Range, set2 As Range, set3 As Range)
    Dim c1, c2, c3, n
    For Each c1 In set1
        For Each c2 In set2
            For Each c3 In set3
                n = n + 1
                Debug.Print "#" & n, c1, c2, c3
            Next c3
        Next c2
    Next c1
End Sub

示例用法：

Sub test()
    allCombo [I2:I4], [J2:J3], [L2:L3]
End Sub

结果：

#1             20            0.5           4 
#2             20            0.5           8 
#3             20            0.8           4 
#4             20            0.8           8 
#5             30            0.5           4 
#6             30            0.5           8 
#7             30            0.8           4 
#8             30            0.8           8 
#9             40            0.5           4 
#10            40            0.5           8 
#11            40            0.8           4 
#12            40            0.8           8 

Answer 2

这是一个sub，首先确定列 I，J，L 中的项目数，然后相应地调整循环：

Sub SteveP()
    Dim N1 As Long, N2 As Long, N3 As Long, K As Long
    Dim m1 As Long, m2 As Long, m3 As Long
    Dim a As Variant, b As Variant, c As Variant

    N1 = Cells(Rows.Count, "I").End(xlUp).Row
    N2 = Cells(Rows.Count, "J").End(xlUp).Row
    N3 = Cells(Rows.Count, "L").End(xlUp).Row
    K = 1

    For m1 = 2 To N1
        a = Cells(m1, "I")
        For m2 = 2 To N2
            b = Cells(m2, "J")
            For m3 = 2 To N3
                c = Cells(m3, "L")
                Cells(K, "M") = a
                Cells(K, "N") = b
                Cells(K, "O") = c
                K = K + 1
            Next m3
        Next m2
    Next m1
End Sub

Answer 3

这是一个完全动态的选项：

Option Explicit

Sub MakeCombos()

Dim myCols As Variant, i As Long, j As Long, myCombos() As Variant
Dim temp() As Variant, LastRow As Long, lngCol As Long, myLens() As Long
Dim index() As Long, totalCombs As Long, count As Long

    '' Prompt user for columns N.B. there is no
    '' data validation, so enter with caution
    myCols = Split(InputBox("Enter the columns as a comma separated list: ", "Column Combos 3000"), ",")
    ReDim myCombos(0 To UBound(myCols))
    ReDim index(0 To UBound(myCols))
    ReDim myLens(0 To UBound(myCols))
    totalCombs = 1

    '' This loop is simply populating myCombos
    '' with the chosen columns. We are also populating
    '' myLens with the maximum length of each column
    For i = 0 To UBound(myCols)
        lngCol = CLng(myCols(i))
        With ActiveSheet
            LastRow = .Cells(.Rows.count, lngCol).End(xlUp).Row
        End With

        ReDim temp(0 To LastRow - 2)

        For j = 2 To LastRow
            temp(j - 2) = Cells(j, lngCol)
        Next j

        myCombos(i) = temp
        myLens(i) = LastRow - 2

        '' Get the total number of combinations
        totalCombs = totalCombs * (LastRow - 1)
    Next i

    '' This is where the magic happens. Note, we
    '' don't have nested for loops. Rather, we are keeping
    '' up with the correct index with the appropriately
    '' named array "index". When one of the indices exceeds
    '' the maximum length, we reset that index and increment
    '' the next index until we have enumerated every combo
    While (count < totalCombs)
        For j = 0 To UBound(myCols)
            Cells(count + 20, j + 1) = myCombos(j)(index(j))
        Next j

        j = UBound(index)
        index(j) = index(j) + 1

        Do While index(j) > myLens(j)
            index(j) = 0
            j = j - 1
            If j < 0 Then Exit Do
            index(j) = index(j) + 1
        Loop

        count = count + 1
    Wend

End Sub

以下是示例输入：

以下是在提示符下输入1,2,4的输出顶部：

以下是在提示符下输入2,3的输出顶部：