Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Why do multiple consecutive unequal conditions not work in vba?

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
like image 375
Maximilian brutus III Avatar asked Oct 20 '16 18:10

Maximilian brutus III


3 Answers

Here is an implementation of the Johnson-Trotter algorithm for enumerating permutations. It is a small modification of one that I wrote once when playing around with brute-force solutions to the Traveling Salesman Problem. Note that it returns a 2-dimensional array, which might consume a lot of memory. It is possible to refactor it so that it is a sub where the permutations are consumed rather than stored. Just replace the part of the code near the bottom (where the current permutation, perm, is stored in the array perms) by the code that uses the 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

Tested like:

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

The first 20 rows of output look like:

enter image description here

Also, 2 1 3 4 5 6 7 8 9 10 is printed in the immediate window. My first version used a vanilla variant away and caused an out-of-memory error with n = 10. I tweaked it so that perms is redimensioned to contain integers (which consume less memory than variants) and is now able to handle 10. It takes about 10 seconds on my machine to run the test code.

like image 176
John Coleman Avatar answered Nov 12 '22 20:11

John Coleman


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
like image 23
user3598756 Avatar answered Nov 12 '22 20:11

user3598756


Try putting all those variables into the array and checking the array for duplicates, if none found, display the message box. Something like this:

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

Read your edit regarding storing permutations and changed the code a bit

like image 1
mozgov_net Avatar answered Nov 12 '22 22:11

mozgov_net