Fragen beantworten

Sub Zahlenpool() 'Ergebnis:in 0,14 s
Dim a(9) As Byte, i As Byte, t As Single
For i = 3 To 9
a(i) = i
Next i
t = Timer
Call Permutation(a, 3, 9)
MsgBox "Fertig nach " & Round(Timer - t, 2) & " Sekunden"
End Sub

Sub Permutation(ByVal a, k As Byte, n As Byte)
Dim i As Byte, x As Byte
If k = n Then
Call Auswerten(a)
Else
For i = k To n
x = a(i)
a(i) = a(k)
a(k) = x
Call Permutation(a, k + 1, n)
Next
End If
End Sub

Sub Auswerten(ByVal a)
Dim m&, n&, o%, p%, q%, r%, s%, v%, z%
m = Abs(a(3) - a(4))
n = Abs(a(4) - a(5))
o = a(5) - 1
p = a(6) - 1
q = Abs(a(6) - a(7))
r = Abs(a(5) - a(8))
s = Abs(a(8) - a(9))
v = a(4) - 2
If m  n And m  o And m  p And m  q And m  r And m  s And m  v And _
n  o And n  p And n  q And n  r And n  s And r  v And _
o  p And o  q And o  r And o  s And o  v And _
p  q And p  r And q  s And q  v And _
q  r And q  s And q  v And _
r  s And r  v And _
s  v Then
Cells(z + 1, 1) = a(3)
Cells(z + 1, 2) = a(4)
Cells(z + 1, 3) = a(5)
Cells(z + 1, 4) = a(6)
Cells(z + 1, 5) = a(7)
Cells(z + 1, 6) = a(8)
Cells(z + 1, 7) = a(9)
End If
End Sub

Gruß, Erhard