賢情逸致

Dim isDone As Boolean
Sub Queen()
On Error Resume Next
Dim sudoary(1 To 11) As Integer
isDone = False
For i = LBound(sudoary) To UBound(sudoary)
   sudoary(i) = CInt(工作表4.Range(Cells(1, LBound(sudoary) + 1), Cells(1, UBound(sudoary) + 1))(1, i))
Next i
If (FirstCheckBoard(sudoary)) Then
   工作表4.Range(Cells(1, LBound(sudoary) + 1), Cells(1, UBound(sudoary) + 1)) = solution(sudoary, 1)
End If
If (Not isDone) Then
   MsgBox "無解"
End If
End Sub
Function FirstCheckBoard(ByVal sudoary)

FirstCheckBoard = True
End Function

Function solution(ByVal sudoary, ByVal cx)
'工作表2.Range("B2:J10") = sudoary
VBA.DoEvents
If (cx > UBound(sudoary)) Then
   solution = sudoary
   isDone = True
   Exit Function
End If
If (sudoary(cx) > 0) Then
   If (Check(sudoary, sudoary(cx), cx)) Then
       solution = sudoary
   Else
       solution = solution(sudoary, cx + 1)
   End If
Else
   For n = LBound(sudoary) To UBound(sudoary)
       If (Check(sudoary, n, cx) = False) Then
           sudoary(cx) = n
           solution = solution(sudoary, cx + 1)
       End If
       
       If (isDone) Then
           Exit Function
       End If
   Next
End If
End Function
Function Check(ByVal ary, ByVal cy, ByVal cx)
For i = LBound(ary) To UBound(ary)
   斜率 = Abs(Abs(i - cx) - Abs(ary(i) - cy))
   If ((ary(i) = cy Or 斜率 = 0) And (cx <> i) And (ary(i) > 0)) Then
            Check = True
            Exit Function
   End If
Next
Check = False
End Function