Составить программу расстановки на доске N*N (N<12) N ферзей

Sub Main()
    Dim k%, i%, j%, m%, n%, Xb%, Yb%, cntFree%, MaxFree%, Uslovie As Boolean
    Dim board%(), Attac() As Boolean, Attac2() As Boolean
    Dim Q%: Q = [N2] 'Количество ферзей, число полей
    ReDim board(Q, Q), Attac(Q, Q), Attac2(Q, Q)
    With [A1:K11]
        .ClearContents
        .Interior.Pattern = xlNone
        .Borders.LineStyle = xlLineStyleNone
    End With
    Range([A1], Cells(Q, Q)).Borders.LineStyle = xlContinuous
    board(1, 1) = 1
    For i = 1 To Q
        Attac(i, 1) = True
        Attac(1, i) = True
        Attac(i, i) = True
    Next i
    For k = 2 To Q
        ' Генерация  позиции следующего ферзя
        MaxFree = 0
        Uslovie = False
        For i = 1 To Q
            For j = 1 To Q
                If board(i, j) = 0 Then
                    ' Проверка гипотезы
                    For n = 1 To Q
                        Attac2(i, n) = True
                        Attac2(n, j) = True
                    Next n
                    For n = 1 To Q
                        If i + n <= Q And j + n <= Q Then
                            Attac2(i + n, j + n) = True
                        End If
                        If i + n <= Q And j - n > 0 Then
                            Attac2(i + n, j - n) = True
                        End If
                        If i - n > 0 And j + n <= Q Then
                            Attac2(i - n, j + n) = True
                        End If
                        If i - n > 0 And j - n > 0 Then
                            Attac2(i - n, j - n) = True
                        End If
                    Next n
                    cntFree = 0
                    For m = 1 To Q
                        For n = 1 To Q
                            If Not (Attac(m, n) Or Attac2(m, n)) Then cntFree = cntFree + 1
                        Next n
                    Next m
                    If MaxFree < cntFree Then
                        Uslovie = True
                        MaxFree = cntFree
                        Xb = j: Yb = i
                    End If
                    ReDim Attac2(Q, Q)
                End If
            Next j
        Next i
        If Uslovie Then
            j = Xb: i = Yb
            board(i, j) = 1
            For n = 1 To Q
                Attac(i, n) = True
                Attac(n, j) = True
            Next n
            For n = 1 To Q
                If i + n <= Q And j + n <= Q Then
                    Attac(i + n, j + n) = True
                End If
                If i + n <= Q And j - n > 0 Then
                    Attac(i + n, j - n) = True
                End If
                If i - n > 0 And j + n <= Q Then
                    Attac(i - n, j + n) = True
                End If
                If i - n > 0 And j - n > 0 Then
                    Attac(i - n, j - n) = True
                End If
            Next n
        End If
    Next k
    For i = 1 To Q
        For j = 1 To Q
            With Cells(i, j)
                If board(i, j) = 1 Then .Value = ChrW(9819) ' Черный ферзь Unicode
                If Attac(i, j) Then .Interior.Color = &H888888
            End With
        Next j
    Next i
    [N3] = MaxFree
End Sub