首页 > 解决方案 > 顺序无关紧要的VBA循环

问题描述

我正在尝试对 3 个变量运行循环,其中顺序无关紧要。

我首先尝试的代码如下,其中 nx 贯穿行,limit 是我数据库的最后一行:

Do While n3 <= limit
    Do While n2 <= limit
       Do While n1 <= limit
          Call Output
          n1 = n1 + 1
       Loop
       Call Output
       n2 = n2 + 1
       n1 = n0
    Loop
    Call Output                         
    n3 = n3 + 1
    n2 = n0
    n1 = n0
Loop

这让我可以测试每一种可能性,但它也会多次重复相同的组合,这会增加运行时间。如果我计划测试 20 个变量,这将使代码无法使用。

有关如何优化此循环的任何提示?

谢谢你。

标签: excelvbaloopsdo-while

解决方案


根据您的评论,您不希望给定组合的排列。假设我们正在混合油漆。我们有五种不同的颜色:

  1. 白色的
  2. 黑色的
  3. 黄色
  4. 蓝色的
  5. 绿色

我们想混合三个罐头的所有可能组合,但是一旦我们混合

白色,蓝色,绿色

我们不需要这些:

白,绿,
蓝绿,白,
蓝绿,蓝,白
蓝,绿,白
蓝,白,绿

因为它们都产生相同的浅蓝绿色。

首先,我们以这种交错的方式运行循环:

Sub MixPaint()
    Dim arr(1 To 5) As String
    Dim i As Long, j As Long, k As Long, LL As Long
    arr(1) = "white"
    arr(2) = "black"
    arr(3) = "blue"
    arr(4) = "green"
    arr(5) = "yellow"
    LL = 1
    For i = 1 To 3
        For j = i + 1 To 4
            For k = j + 1 To 5
                Cells(LL, 1) = arr(i) & ":" & arr(j) & ":" & arr(k)
                LL = LL + 1
            Next k
        Next j
    Next i
End Sub

这让我们:

在此处输入图像描述

这会删除置换的重复项,但也会删除以下组合:

蓝色,蓝色,白色

为了取回这些,我们稍微调整循环:

Sub MixPaint2()
    Dim arr(1 To 5) As String
    Dim i As Long, j As Long, k As Long, LL As Long
    arr(1) = "white"
    arr(2) = "black"
    arr(3) = "blue"
    arr(4) = "green"
    arr(5) = "yellow"
    LL = 1
    For i = 1 To 5
        For j = i To 5
            For k = j To 5
                Cells(LL, 5) = arr(i) & ":" & arr(j) & ":" & arr(k)
                LL = LL + 1
            Next k
        Next j
    Next i
End Sub

现在我们有:

在此处输入图像描述

这可能是你所追求的。


推荐阅读