【问题标题】:VBA loop where order doesn't matter顺序无关紧要的VBA循环
【发布时间】:2020-09-10 10:37:00
【问题描述】:

我正在尝试对 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 个变量,这将使代码无法使用。

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

谢谢。

【问题讨论】:

  • This allows me to test every possibility : 很抱歉,什么都有可能?

标签: excel vba loops do-while


【解决方案1】:

如果你需要循环遍历一个表格,我会循环抛出表格的行和列,使用 double for o double while,遍历所有单元格,以避免重复组合。根据您的 while 方法,这将是:

Do While row <= rowLimit
   Do While col <= colLimit
      'with if conditions you can make your operations

      col = col +1
   Loop
   row = row + 1
Loop

如果需要独立循环遍历行,则不需要嵌套while,每个while都可以独立循环其行。如果 n1、n2 和 n3 相互依赖,则需要解释它们,以便可以考虑它们的关系以从嵌套循环中排除确定的组合。 但是,如果组合的顺序在我检查的情况下很重要,则循环中没有重复的组合。 这是您的循环日志,例如 n1=n2=n3 和 limit =2

1 0 0
0 1 0
0 0 0
1 0 0
2 0 0
3 0 0
0 1 0
1 1 0
2 1 0
3 1 0
0 2 0
1 2 0
2 2 0
3 2 0
0 3 0
0 0 1
1 0 1
2 0 1
3 0 1
0 1 1
1 1 1
2 1 1
3 1 1
0 2 1
1 2 1
2 2 1
3 2 1
0 3 1
0 0 2
1 0 2
2 0 2
3 0 2
0 1 2
1 1 2
2 1 2
3 1 2
0 2 2
1 2 2
2 2 2
3 2 2
0 3 2

但是如果顺序无关紧要,并且您需要遍历每个 n,直到行限制,并且没有 n 值重复,那么 while 循环可以是独立的,因此不需要嵌套。

所以我不确定我是否回答了你的问题或者我遗漏了什么。

希望对你有所帮助

【讨论】:

  • 感谢您的回复。对于您提供的示例,您重复某些组合,例如:0 1 0 = 0 0 1 = 1 0 0。我没有以正确的方式解释自己,但我想避免这些重复。如果你只考虑一次组合,不考虑顺序,你可以清楚地看到它会节省很多时间。如果可能的话,你能提供代码示例吗?
【解决方案2】:

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

  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

现在我们有了:

这可能是你所追求的。

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2011-12-11
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2018-05-19
    • 1970-01-01
    • 1970-01-01
    • 2011-06-10
    相关资源
    最近更新 更多