Question

I was wondering why the following syntax does not work the way I thought it would in VBA, and what I should do to ensure it does;

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

This is a simplified example, which can still be manually obtained with:

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

But my actual intended code has 10 such variables multiple times, which makes it unfeasible with 55 unequal conditions, or likely for me to make a typo. I think there is a more efficient way but I have not found it.

Ps. My goal is to only have a message box pop up if all the variables are unique.

I have obtained my goal, though it can probably be done much more efficient than:

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

Answer 1

以下是用于枚举排列的Johnson-Trotter algorithm的实现。这是我在使用旅行商问题的蛮力解决方案时曾写过的一个小修改。请注意，它返回一个二维数组，可能会占用大量内存。可以重构它以使其成为消耗排列而不是存储排列的子。只需通过使用排列的代码替换底部附近的代码部分（当前排列perm存储在数组perms中）。

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

测试如下：

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。我的第一个版本使用了一个vanilla变种，导致n = 10出现内存不足错误。我调整它以便perms重新定义为包含整数（比变体消耗更少的内存）并且现在能够处理10。我的机器上运行测试代码大约需要10秒钟。

Answer 2

You could simply add a check right after the beginning of each inner loop, like follows

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

Answer 3

尝试将所有这些变量放入数组并检查数组是否有重复项，如果没有找到，则显示消息框。像这样：

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

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

Why do multiple consecutive unequal conditions not work in vba?

3 个答案: