为什么多个连续的不平等的条件不适用于VBA?

我想知道为什么下面的语法不能像我认为的那样在VBA中工作,我应该怎么做才能确保它的工作;

For a = 1 To 10 For b = 1 To 10 For c = 1 To 10 If a <> b <> c Then MsgBox (a & " " & b & " " & c) End If Next c Next b Next a 

这是一个简化的例子,仍然可以通过以下方式手动获取:

 if a<>b and b<>c and c<>a then 

但是我的实际代码多次有10个这样的variables,这使得55个不相等的条件不可行,或者我可能会犯一个错字。 我认为有一个更有效的方法,但我没有find它。

PS。 我的目标是只有一个消息框popup,如果所有的variables是唯一的。

我已经获得了我的目标,尽pipe它可能比以下更高效:

 For a = 1 To 10 check(a) = True For b = 1 To 10 If check(b) = False Then check(b) = True For c = 1 To 10 If check(c) = False Then check(c) = True For d = 1 To 10 If check(d) = False Then check(d) = True For e = 1 To 10 If check(e) = False Then check(e) = True MsgBox (a & " " & b & " " & c & " " & d & " " & e) End If check(e) = False check(a) = True check(b) = True check(c) = True check(d) = True Next e End If check(d) = False check(a) = True check(b) = True check(c) = True Next d End If check(c) = False check(a) = True check(b) = True Next c End If check(b) = False check(a) = True Next b Next a 

这里是枚举排列的Johnson-Trotteralgorithm的一个实现。 这是我在旅行推销员问题的蛮力解决scheme中写的一个小改动。 请注意,它返回一个二维数组,这可能会消耗大量的内存。 可以对它进行重构,使其成为排列被消耗而不是被存储的子集。 只需要使用排列的代码replace底部附近的代码部分(当前排列, perm存储在数组中的permutation)。

 Function Permutations(n As Long) As Variant 'implements Johnson-Trotter algorithm for 'listing permutations. Returns results as a variant array 'Thus not feasible for n > 10 or so Dim perm As Variant, perms As Variant Dim i As Long, j As Long, k As Long, r As Long, D As Long, m As Long Dim p_i As Long, p_j As Long Dim state As Variant m = Application.WorksheetFunction.Fact(n) ReDim perm(1 To n) ReDim perms(1 To m, 1 To n) As Integer ReDim state(1 To n, 1 To 2) 'state(i,1) = where item i is currently in perm 'state(i,2) = direction of i k = 1 'will point to current permutation For i = 1 To n perm(i) = i perms(k, i) = i state(i, 1) = i state(i, 2) = -1 Next i state(1, 2) = 0 i = n 'from here on out, i will denote the largest moving 'will be 0 at the end Do While i > 0 D = state(i, 2) 'swap p_i = state(i, 1) p_j = p_i + D j = perm(p_j) perm(p_i) = j state(i, 1) = p_j perm(p_j) = i state(j, 1) = p_i p_i = p_j If p_i = 1 Or p_i = n Then state(i, 2) = 0 Else p_j = p_i + D If perm(p_j) > i Then state(i, 2) = 0 End If For j = i + 1 To n If state(j, 1) < p_i Then state(j, 2) = 1 Else state(j, 2) = -1 End If Next j 'now find i for next pass through loop If i < n Then i = n Else i = 0 For j = 1 To n If state(j, 2) <> 0 And j > i Then i = j Next j End If 'record perm in perms: k = k + 1 For r = 1 To n perms(k, r) = perm(r) Next r Loop Permutations = perms End Function 

testing像:

 Sub test() Range("A1:G5040").Value = Permutations(7) Dim A As Variant, i As Long, s As String A = Permutations(10) For i = 1 To 10 s = s & " " & A(3628800, i) Next i Debug.Print s End Sub 

前20行的输出如下所示:

在这里输入图像说明

另外, 2 1 3 4 5 6 7 8 9 10被打印在即时窗口中。 我的第一个版本使用了一个香草变种,导致n = 10的内存不足错误。 我调整了它,使perms尺寸包含整数(比变体消耗更less的内存),现在能够处理10 。 我的机器上运行testing代码大概需要10秒。

您可以简单地在每个内部循环开始之后添加一个检查,如下所示

 For a = 1 To 10 For b = 1 To 10 If b <> a Then '<-- this check will make sure subsequent inner loops shouldn't bother but for their loops variables For c = 1 To 10 If c <> b Then '<-- same comment as preceeding one For d = 1 to 10 If d <> c then MsgBox (a & " " & b & " " & c & " " & d) '<-- last check for last two variables Next d End If Next c End If Next b Next a 

尝试将所有这些variables放入数组,并检查数组是否重复,如果没有find,则显示消息框。 像这样的东西:

 Sub dupfind() Dim ArrHelper(2) As Long Dim k As Long Dim j As Long Dim ans As Long Dim dupl As Boolean Dim ArrAnswers() As Long ans = 0 For a = 1 To 10 ArrHelper(0) = a For b = 2 To 10 ArrHelper(1) = b For c = 1 To 10 ArrHelper(2) = c dupl = False For k = 0 To UBound(ArrHelper) - 1 For j = k + 1 To UBound(ArrHelper) If ArrHelper(k) = ArrHelper(j) Then dupl = True End If Next j Next k If dupl = False Then ReDim Preserve ArrAnswers(3, ans) ArrAnswers(0, ans) = a ArrAnswers(1, ans) = b ArrAnswers(2, ans) = c ans = ans + 1 End If Next c Next b Next a End Sub 

阅读您关于存储排列的编辑,并稍微更改代码