Excel VBA代码-带限制的组合

我必须生成一个组合列表，这些组合是字段的指示符，因为我试图生成一些条件来查询数据

在动力/扭矩/气缸与

1,2,4

组合的示例中：

我需要计算出这3个字段的组合，因此输出为：

那么基本上所有的组合，但不是来自同一个“桶”，如果这有意义的话

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

现在我们有了组合桶，需要在这些字段中进行组合

此外，我正在寻找关于如何接近algo的指导，而不一定有人为我做嵌套循环： 用法示例： 结果: 嵌套循环： 用法示例： 结果:

---

下面是一个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

---

这里有一个子集，它首先确定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

---

这里有一个完全动态的选项：

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

选项显式
子MakeCombos（）
Dim myCols作为变体，i作为Long，j作为Long，myCombos（）作为变体
Dim temp（）为变量，LastRow为长，lngCol为长，myLens（）为长
Dim index（）为长，totalCombs为长，计数为长
“”提示用户输入列N.B。没有
“”数据验证，请谨慎输入
myCols=Split（输入框（“以逗号分隔的列表形式输入列：”，“列组合3000”），“，”）
重读myCombos（0到UBound（myCols））
ReDim索引（0到UBound（myCols））
雷迪姆迈伦（0到UBound（myCols））
totalCombs=1
“”此循环只是填充myCombos
“”中包含所选列。我们也在人口中
“”myLens，每个列的最大长度
对于i=0到UBound（myCols）
lngCol=CLng（myCols（i））
使用ActiveSheet
LastRow=.Cells（.Rows.count，lngCol）.End（xlUp）.Row
以
重拨温度（0至最后一行-2）
对于j=2到最后一行
温度（j-2）=单元（j，lngCol）
下一个j
myCombos（i）=温度
迈伦（i）=最后一行-2
“”获取组合的总数
totalCombs=totalCombs*（最后一行-1）
接下来我
“这就是魔法发生的地方。注意，我们
“”没有嵌套的for循环。相反，我们正在保持
“”使用适当的
“”命名为数组“索引”。当其中一个指数超过
“”最大长度，我们重置该索引并递增
“”将创建下一个索引，直到我们枚举了每个组合
While（计数<总梳数）
对于j=0到UBound（myCols）
细胞（计数+20，j+1）=myCombos（j）（指数（j））
下一个j
j=UBound（索引）
指数（j）=指数（j）+1
Do While index（j）>myLens（j）
指数（j）=0
j=j-1
如果j<0，则退出Do
指数（j）=指数（j）+1
环
计数=计数+1
温德
端接头

以下是示例输入：

以下是在提示下输入

1,2,4

的输出顶部：

以下是在提示下输入

2,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

选项显式
子MakeCombos（）
Dim myCols作为变体，i作为Long，j作为Long，myCombos（）作为变体
Dim temp（）为变量，LastRow为长，lngCol为长，myLens（）为长
Dim index（）为长，totalCombs为长，计数为长
“”提示用户输入列N.B。没有
“”数据验证，请谨慎输入
myCols=Split（输入框（“以逗号分隔的列表形式输入列：”，“列组合3000”），“，”）
重读myCombos（0到UBound（myCols））
ReDim索引（0到UBound（myCols））
雷迪姆迈伦（0到UBound（myCols））
totalCombs=1
“”此循环只是填充myCombos
“”中包含所选列。我们也在人口中
“”myLens，每个列的最大长度
对于i=0到UBound（myCols）
lngCol=CLng（myCols（i））
使用ActiveSheet
LastRow=.Cells（.Rows.count，lngCol）.End（xlUp）.Row
以
重拨温度（0至最后一行-2）
对于j=2到最后一行
温度（j-2）=单元（j，lngCol）
下一个j
myCombos（i）=温度
迈伦（i）=最后一行-2
“”获取组合的总数
totalCombs=totalCombs*（最后一行-1）
接下来我
“这就是魔法发生的地方。注意，我们
“”没有嵌套的for循环。相反，我们正在保持
“”使用适当的
“”命名为数组“索引”。当其中一个指数超过
“”最大长度，我们重置该索引并递增
“”将创建下一个索引，直到我们枚举了每个组合
While（计数<总梳数）
对于j=0到UBound（myCols）
细胞（计数+20，j+1）=myCombos（j）（指数（j））
下一个j
j=UBound（索引）
指数（j）=指数（j）+1
Do While index（j）>myLens（j）
指数（j）=0
j=j-1
如果j<0，则退出Do
指数（j）=指数（j）+1
环
计数=计数+1
温德
端接头

以下是示例输入：

以下是在提示下输入

1,2,4

的输出顶部：

以下是在提示下输入

2,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