Hi zusammen,
nun bekommen wir die 44 Lösungen auch per VBA. Vorausgesetzt wird nur,
dass der Bereich A1:C31 richtig gefüllt ist. Den Rest (bis Spalte Q) macht VBA.
In J:Q stehen die Ergebnisse in Form der Kantenfolgen:
| | S | T | U | V | W | X | Y | Z | AA |
| 1 | | | | | | | | | |
| 2 | | | | | o | | | | |
| 3 | | | | 4 | | 3 | | | |
| 4 | | | 4 | | | | 3 | | |
| 5 | | 4 | | | | | | 3 | |
| 6 | o | 2 | 2 | 2 | 2 | 2 | 2 | 2 | o |
| 7 | 1 | 5 | | | | | | 7 | 6 |
| 8 | 1 | | 5 | | | | 7 | | 6 |
| 9 | 1 | | | 5 | | 7 | | | 6 |
| 10 | 1 | | | | o | | | | 6 |
| 11 | 1 | | | 7 | | 5 | | | 6 |
| 12 | 1 | | 7 | | | | 5 | | 6 |
| 13 | 1 | 7 | | | | | | 5 | 6 |
| 14 | St | 8 | 8 | 8 | 8 | 8 | 8 | 8 | o |
| | A | B | C | D | E | F | G | H |
| 1 | | | 4 | | 41 | 7 | 8 | |
| 2 | 7 | 1 | 2 | | 71 | 4 | 2 | 5 |
| 3 | 8 | | 5 | | 21 | 7 | 8 | |
| 4 | | | | | 81 | 4 | 2 | 5 |
| 5 | 4 | | 3 | | 51 | 7 | 8 | |
| 6 | 5 | 2 | 7 | | 42 | 3 | 7 | 6 |
| 7 | 1 | | 6 | | 32 | 4 | 5 | 1 |
| 8 | | | | | 52 | 3 | 7 | 6 |
| 9 | | | 2 | | 72 | 4 | 5 | 1 |
| 10 | 4 | 3 | 7 | | 12 | 3 | 7 | 6 |
| 11 | | | 6 | | 62 | 4 | 5 | 1 |
| 12 | | | | | 23 | 4 | | |
| 13 | | | 2 | | 43 | 2 | 7 | 6 |
| 14 | 3 | 4 | 5 | | 73 | 4 | | |
| 15 | | | 1 | | 63 | 4 | | |
| 16 | | | | | 24 | 3 | | |
| 17 | | | 4 | | 34 | 2 | 5 | 1 |
| 18 | 6 | 5 | 2 | | 54 | 3 | | |
| 19 | 8 | | 1 | | 14 | 3 | | |
| 20 | | | | | 45 | 6 | 8 | |
| 21 | | | 3 | | 65 | 4 | 2 | 1 |
| 22 | 5 | 6 | 2 | | 25 | 6 | 8 | |
| 23 | 8 | | 7 | | 85 | 4 | 2 | 1 |
| 24 | | | | | 15 | 6 | 8 | |
| 25 | | | 3 | | 36 | 5 | 8 | |
| 26 | 1 | 7 | 2 | | 56 | 3 | 2 | 7 |
| 27 | 8 | | 6 | | 26 | 5 | 8 | |
| 28 | | | | | 86 | 3 | 2 | 7 |
| 29 | | | | | 76 | 5 | 8 | |
| 30 | 1 | 8 | 5 | | 37 | 1 | 8 | |
| 31 | 7 | | 6 | | 17 | 3 | 2 | 6 |
| 32 | | | | | 27 | 1 | 8 | |
| 33 | | | | | 87 | 3 | 2 | 6 |
| 34 | | | | | 67 | 1 | 8 | |
| 35 | | | | | 18 | 5 | 6 | |
| 36 | | | | | 58 | 1 | 7 | |
| 37 | | | | | 78 | 5 | 6 | |
| 38 | | | | | 68 | 1 | 7 | |
| | J | K | L | M | N | O | P | Q |
| 1 | 1 | 4 | 3 | 2 | 5 | 6 | 7 | 8 |
| 2 | 1 | 4 | 3 | 2 | 5 | 8 | 7 | 6 |
| 3 | 1 | 4 | 3 | 7 | 8 | 5 | 2 | 6 |
| 4 | 1 | 4 | 3 | 7 | 8 | 6 | 2 | 5 |
| 5 | 1 | 4 | 3 | 6 | 5 | 2 | 7 | 8 |
| 6 | 1 | 4 | 3 | 6 | 8 | 7 | 2 | 5 |
| 7 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 |
| 8 | 1 | 2 | 3 | 4 | 5 | 8 | 7 | 6 |
| 9 | 1 | 2 | 7 | 8 | 5 | 4 | 3 | 6 |
| 10 | 1 | 2 | 7 | 8 | 6 | 3 | 4 | 5 |
| 11 | 1 | 2 | 6 | 5 | 4 | 3 | 7 | 8 |
| 12 | 1 | 2 | 6 | 8 | 7 | 3 | 4 | 5 |
| 13 | 1 | 5 | 6 | 3 | 4 | 2 | 7 | 8 |
| 14 | 1 | 5 | 6 | 2 | 4 | 3 | 7 | 8 |
| 15 | 1 | 5 | 8 | 7 | 3 | 4 | 2 | 6 |
| 16 | 1 | 5 | 8 | 7 | 2 | 4 | 3 | 6 |
| 17 | 7 | 3 | 4 | 2 | 6 | 5 | 1 | 8 |
| 18 | 7 | 3 | 4 | 2 | 6 | 8 | 1 | 5 |
| 19 | 7 | 3 | 4 | 5 | 6 | 2 | 1 | 8 |
| 20 | 7 | 3 | 4 | 5 | 8 | 1 | 2 | 6 |
| 21 | 7 | 3 | 4 | 1 | 8 | 5 | 2 | 6 |
| 22 | 7 | 3 | 4 | 1 | 8 | 6 | 2 | 5 |
| 23 | 7 | 2 | 4 | 3 | 6 | 5 | 1 | 8 |
| 24 | 7 | 2 | 4 | 3 | 6 | 8 | 1 | 5 |
| 25 | 7 | 2 | 5 | 6 | 3 | 4 | 1 | 8 |
| 26 | 7 | 2 | 5 | 8 | 1 | 4 | 3 | 6 |
| 27 | 7 | 2 | 1 | 8 | 5 | 4 | 3 | 6 |
| 28 | 7 | 2 | 1 | 8 | 6 | 3 | 4 | 5 |
| 29 | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 8 |
| 30 | 7 | 6 | 5 | 2 | 3 | 4 | 1 | 8 |
| 31 | 7 | 6 | 8 | 1 | 4 | 3 | 2 | 5 |
| 32 | 7 | 6 | 8 | 1 | 2 | 3 | 4 | 5 |
| 33 | 8 | 5 | 4 | 3 | 2 | 1 | 7 | 6 |
| 34 | 8 | 5 | 4 | 3 | 7 | 1 | 2 | 6 |
| 35 | 8 | 5 | 2 | 3 | 4 | 1 | 7 | 6 |
| 36 | 8 | 5 | 2 | 7 | 1 | 4 | 3 | 6 |
| 37 | 8 | 5 | 1 | 7 | 3 | 4 | 2 | 6 |
| 38 | 8 | 5 | 1 | 7 | 2 | 4 | 3 | 6 |
| 39 | 8 | 6 | 3 | 4 | 2 | 7 | 1 | 5 |
| 40 | 8 | 6 | 3 | 4 | 1 | 7 | 2 | 5 |
| 41 | 8 | 6 | 2 | 4 | 3 | 7 | 1 | 5 |
| 42 | 8 | 6 | 2 | 1 | 7 | 3 | 4 | 5 |
| 43 | 8 | 6 | 7 | 1 | 4 | 3 | 2 | 5 |
| 44 | 8 | 6 | 7 | 1 | 2 | 3 | 4 | 5 |
Und hier der Code:
Option Explicit
Option Base 0
Sub NikoHaus()
Dim ww, ee() As Integer, uu As Integer, aa As Byte, bb As Byte, ii As Byte
Dim jj As Byte, zz As Integer, nn As Integer, kk As Byte, mm As Byte
ListeZiele
ww = Range("E1:H38")
ReDim ee(1, 8, 1 To 100)
ee(0, 0, 1) = 7: ee(0, 1, 1) = 1 ' Startwerte
ee(0, 0, 2) = 1: ee(0, 1, 2) = 7 ' (Start unten links bei St
ee(0, 0, 3) = 1: ee(0, 1, 3) = 8 ' mit Kanten 1, 7 oder 8)
For uu = 1 To 8
aa = bb
bb = 1 - aa
nn = 0
For zz = 1 To UBound(ee, 3)
If ee(aa, uu, zz) = 0 Then Exit For
For ii = 1 To UBound(ww)
If ww(ii, 1) = 10 * ee(aa, uu - 1, zz) + ee(aa, uu, zz) Then
For jj = 2 To 4
If ww(ii, jj) = 0 Then Exit For
For kk = 1 To uu
If ww(ii, jj) = ee(aa, kk, zz) Then Exit For
Next kk
If kk > uu Then
nn = nn + 1
For mm = 0 To uu
ee(bb, mm, nn) = ee(aa, mm, zz)
Next mm
ee(bb, mm, nn) = ww(ii, jj)
End If
Next jj
End If
Next ii
Next zz
Next uu
For zz = 1 To UBound(ee, 3)
If ee(1, 8, zz) = 0 Then Exit For
For uu = 1 To 8
Cells(zz, uu + 9) = ee(1, uu, zz)
Next uu
Next zz
End Sub
Sub ListeZiele() ' Liste der möglichen Ziele pro Kante (gerichtet)
Dim mm As Byte, vv As Byte, nn As Byte, zz As Long, cc As Long
For mm = 2 To 30 Step 4
For vv = mm - 1 To mm + 1
If Cells(vv, 1) > 0 Then
zz = zz + 1: Cells(zz, 5) = 10 * Cells(vv, 1) + Cells(mm, 2)
cc = 5
For nn = mm - 1 To mm + 1
If Cells(nn, 3) > 0 Then cc = cc + 1: Cells(zz, cc) = Cells(nn, 3)
Next nn
End If
If Cells(vv, 3) > 0 Then
zz = zz + 1: Cells(zz, 5) = 10 * Cells(vv, 3) + Cells(mm, 2)
cc = 5
For nn = mm - 1 To mm + 1
If Cells(nn, 1) > 0 Then cc = cc + 1: Cells(zz, cc) = Cells(nn, 1)
Next nn
End If
Next vv
Next mm
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich
