Dlaczego wiele kolejnych nierównych warunków nie działa w vba?

Question

Zastanawiam się, dlaczego następująca składnia nie działa tak, jak myślałem w VBA, i co powinienem zrobić, aby to zrobić;

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 

To jest uproszczony przykład, który można jeszcze ręcznie uzyskane z:

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

Ale mój rzeczywisty kod zamierzonym posiada 10 takie zmienne wiele razy, co sprawia, że ​​jest niewykonalne z 55 nierównych warunkach lub prawdopodobnie dla mnie by zrobić literówkę. Myślę, że jest bardziej skuteczny sposób, ale nie znalazłem go.

Ps. Moim celem jest wyświetlenie tylko okna komunikatu, jeśli wszystkie zmienne są unikalne.

Ja osiągnąłem swój cel, choć może to prawdopodobnie zrobić dużo bardziej wydajny niż:

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

Oto implementacja Johnson-Trotter algorithm do wyliczenia permutacji. Jest to mała modyfikacja tego, którą napisałem raz, gdy bawiłam się brutalnymi rozwiązaniami problemu z Traveling Salesman. Zwróć uwagę, że zwraca dwuwymiarową tablicę, która może zużywać dużo pamięci. Możliwe jest jego refaktorowanie tak, aby było podrzędnym miejscem, w którym permutacje są raczej zużywane niż przechowywane. Wystarczy zastąpić część kodu w pobliżu dna (gdzie aktualna permutacja, perm, jest przechowywana w tablicy perms) przez kod, który używa permutacji.

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 

Testowany jak:

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 

pierwszych 20 rzędach wyjściowego wyglądać następująco:

Również 2 1 3 4 5 6 7 8 9 10 drukowany jest w bezpośrednim okna. Moja pierwsza wersja użyła wariantu waniliowego i spowodowała błąd braku pamięci z n = 10. Poprawiłem go tak, aby perms został zredefiniowany w celu zawarcia liczb całkowitych (które zużywają mniej pamięci niż warianty) i jest teraz w stanie obsłużyć 10. Wykonanie kodu testowego zajmuje mi około 10 sekund.

Answer 2

Można po prostu dodać czek tuż po rozpoczęciu każdej pętli wewnętrznej, jak następuje

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

Spróbuj umieścić wszystkie te zmienne w tablicy i sprawdzić tablicę pod kątem duplikatów, jeśli żadna z nich nie zostanie znaleziona, wyświetl pole komunikatu. Coś takiego:

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 

Czytaj edycję dotyczących przechowywania permutacji i zmienił kod trochę