задача о восьми ферзях

Ответ от Makfromkz[гуру]
вот код на VBA
Function analiz(x, y) ' эта функция возвращает 1 если на заданую клетку нельзя поставить ферзя
analiz = 0
If Cells(x, y) > 0 Then
analiz = 1
Exit Function
End If
For jj3 = 1 To 8
If y <> jj3 Then
If x = Cells(10 + jj3, 1) Then
analiz = 1
Exit Function
End If
End If
Next jj3
End Function
Private Sub kletki(x, y, z) ' эта процедура увеличивает на 1 содержимое клеток которые бьет ферзя при z = 1 при z = -1 уменьшает на 1 их содержимое
For jj1 = 1 To 8
Cells(x, jj1) = Cells(x, jj1) + z
Next jj1
For jj2 = 1 To 8
Cells(jj2, y) = Cells(jj2, y) + z
Next jj2
For jj3 = -8 To 8
If x + jj3 < 9 And y + jj3 < 9 And x + jj3 > 0 And y + jj3 > 0 Then
Cells(x + jj3, y + jj3) = Cells(x + jj3, y + jj3) + z
End If
Next jj3
For jj3 = -8 To 8
If x - jj3 < 9 And y + jj3 < 9 And x - jj3 > 0 And y + jj3 > 0 Then
Cells(x - jj3, y + jj3) = Cells(x - jj3, y + jj3) + z
End If
Next jj3
End Sub
Sub ppp() ' главная процедура перебирает все комбинации ферзей по алгоритму перебора с откатами при неудаче
Range(Cells(1, 1), Cells(8, 8)).ClearContents
nn = 0
For ii1 = 1 To 8
Cells(1, 11) = ii1
If analiz(ii1, 1) = 0 Then
Call kletki(ii1, 1, 1)
For ii2 = 1 To 8
If ii2 <> ii1 Then
Cells(1, 12) = ii2
If analiz(ii2, 2) = 0 Then
Call kletki(ii2, 2, 1)
For ii3 = 1 To 8
If ii3 <> ii1 And ii3 <> ii2 Then
Cells(1, 13) = ii3
If analiz(ii3, 3) = 0 Then
Call kletki(ii3, 3, 1)
For ii4 = 1 To 8
If ii4 <> ii1 And ii4 <> ii2 And ii4 <> ii3 Then
Cells(1, 14) = ii4
If analiz(ii4, 4) = 0 Then
Call kletki(ii4, 4, 1)
For ii5 = 1 To 8
If ii5 <> ii1 And ii5 <> ii2 And ii5 <> ii3 And ii5 <> ii4 Then
Cells(1, 15) = ii5
If analiz(ii5, 5) = 0 Then
Call kletki(ii5, 5, 1)
For ii6 = 1 To 8
If ii6 <> ii1 And ii6 <> ii2 And ii6 <> ii3 And ii6 <> ii4 And ii6 <> ii5 Then
Cells(1, 16) = ii6
If analiz(ii6, 6) = 0 Then
Call kletki(ii6, 6, 1)
For ii7 = 1 To 8
If ii7 <> ii1 And ii7 <> ii2 And ii7 <> ii3 And ii7 <> ii4 And ii7 <> ii5 And ii7 <> ii6 Then
Cells(1, 17) = ii7
If analiz(ii7, 7) = 0 Then
Call kletki(ii7, 7, 1)
For ii8 = 1 To 8
If ii8 <> ii1 And ii8 <> ii2 And ii8 <> ii3 And ii8 <> ii4 And ii8 <> ii5 And ii8 <> ii6 And ii8 <> ii6 Then
Cells(1, 18) = ii8
If analiz(ii8, 8) = 0 Then
Call kletki(ii8, 8, 1)
nn = nn + 1
Cells(10, 1) = nn
Cells(10 + nn, 1) = ii1: Cells(10 + nn, 2) = ii2: Cells(10 + nn, 3) = ii3: Cells(10 + nn, 4) = ii4: Cells(10 + nn, 5) = ii5: Cells(10 + nn, 6) = ii6: Cells(10 + nn, 7) = ii7: Cells(10 + nn, 8) = ii8
Call kletki(ii8, 8, -1) ' тут откат неправильного хода ))
End If
End If
Next ii8
Call kletki(ii7, 7, -1)
End If
End If
Next ii7
Call kletki(ii6, 6, -1)
End If
End If
Next ii6
Call kletki(ii5, 5, -1)
End If
End If
Next ii5
Call kletki(ii4, 4, -1)
End If
End If
Next ii4
Call kletki(ii3, 3, -1)
End If
End If
Next ii3
Call kletki(ii2, 2, -1)
End If
End If
Next ii2
Call kletki(ii1, 1, -1)
End If
Next ii1
End Sub
вот один из результатов

Источник: http://ru.wikipedia.org/wiki/Задача_о_восьми_ферзях