Makro

Sub Probe9()
Dim a As Variant, t As Single 'in 3491 Sek kein Resultat!!
t = Timer
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
Call Permutation(a, 0)
MsgBox "Fertig nach " & Round(Timer - t, 1) & " Sekunden"
End Sub

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

Sub Auswerten(ByVal a)
Dim z%, c%
c = 15
If a(0) + a(1) + a(2) = c And _
a(3) + a(4) + a(5) = c And _
a(6) + a(7) + a(8) = c And _
a(0) + a(3) + a(6) = c And _
a(1) + a(4) + a(5) = c And _
a(2) + a(5) + a(8) = c Then
z = z + 1
Cells(1, 1) = a(0) & a(1) & a(2)
Cells(1, 2) = a(3) & a(4) & a(5)
Cells(1, 3) = a(6) & a(7) & a(8)
End If
End Sub