由八皇后问题扩展开来，即n*n的棋盘上摆放n个皇后，使其不能互相攻击，即任意两个皇后都不能处于同一行、同一列或同一斜线上，问有多少种摆法。
分析：
问题可以转化为12345...n 的满足某种条件(行已不等,列亦不等,只需设定其不在同一斜线上,即斜率不为 1 或-1 )的排列.
代码：
Private Sub queensn(ByVal n As Integer, ByRef result() As String) '计算n皇后问题的过程
Dim i As Long, J As Integer, k As Integer, number As Long, num As Long '循环变量
Dim FIT As Boolean '判定是否符合条件
Dim ALL(), out() As String '用于输出的数组
ReDim ALL(1 To n)
ReDim out(1 To n)
number = 1
Dim TEMP1 As Long, TEMP2 As Integer '进制转换中间变量
For i = 1 To n
number = number * i ' get n!
Next
For i = 1 To number ' 穷举n!种排列
ALL(1) = 1
TEMP1 = i
For J = 2 To n
TEMP2 = TEMP1 Mod J '混合进制
TEMP1 = TEMP1 \ J
If TEMP2 = 0 Then
ALL(J) = J 'temp2为 0则放在最后
Else
For k = J To TEMP2 + 1 Step -1
ALL(k) = ALL(k - 1) ' temp2之后的元素后移一位
Next
ALL(TEMP2) = J 'temp2不为 0 则置于第temp2个元素前
End If
Next '至此得到12345...n的一个排列
FIT = True '初始化变量
'循环判断有否两个皇后存在互吃
For J = 1 To n
For k = n To 1 Step -1
If Not k = J Then
If ALL(k) - ALL(J) = J - k Or ALL(k) - ALL(J) = k - J Then
FIT = False
GoTo pass '跳出循环
End If
End If
Next
Next
If FIT Then '满足条件时
num = num + 1 '输出编号
ReDim Preserve result(1 To num)
For J = 1 To n
out(J) = String(n, StrConv("□", vbWide))
Mid(out(J), ALL(J), 1) = StrConv("Q", vbWide)
Next
result(num) = "第" & num & "种方法:" & vbCrLf & Join(out, vbCrLf) '输出第 num 种 n 个皇后摆放状态
End If
pass:
Next
End Sub
Private Sub Command1_Click()
Dim result() As String
queensn 9, result '九皇后
Open "d:\result.txt" For Binary As #1
Put #1, , Join(result, vbCrLf)
Close #1
MsgBox "ok"
End Sub
本文地址：http://com.8s8s.com/it/it44541.htm