8皇后排列问题

lsdongjh

湊个热闹，递归算法，92种解，结果放在数组中，未进行外显处理

1. Dim Queen() As Integer '数组索引为 行号，值为 列号
   
2. Dim arrResult As Variant
   
3. 
   
4. Sub Main()
   
5.     ReDim Queen(1 To 8) As Integer
   
6.     FindPlace 1
   
7.     MsgBox "共有【" & UBound(arrResult, 2) & "】组解"
   
8. End Sub
   
9. 
   
10. Function FindPlace(intCurRowID As Integer)
    
11.     Dim intColID As Integer, intNextRowID As Integer
    
12.    
    
13.     For intColID = 1 To 8
    
14.         If CanPlaced(intCurRowID, intColID) Then
    
15.             Queen(intCurRowID) = intColID
    
16.             If intCurRowID = 8 Then
    
17.                 GetResult
    
18.                 Exit Function
    
19.             End If
    
20.             intNextRowID = intCurRowID + 1
    
21.             FindPlace intNextRowID
    
22.         End If
    
23.     Next
    
24.     Queen(intCurRowID) = 0
    
25. End Function
    
26. 
    
27. Function CanPlaced(intCurRowID As Integer, intCurColID As Integer) As Boolean
    
28.     Dim intRow As Integer
    
29.    
    
30.     For intRow = 1 To intCurRowID - 1
    
31.         '同一列有皇后
    
32.         If Queen(intRow) = intCurColID Then
    
33.             CanPlaced = False
    
34.             Exit Function
    
35.         End If
    
36.         '同一主对角线（行号+列号 相等）
    
37.         If intRow + Queen(intRow) = intCurRowID + intCurColID Then
    
38.             CanPlaced = False
    
39.             Exit Function
    
40.         End If
    
41.         '同一主对角线（行号-列号 相等）
    
42.         If intRow - Queen(intRow) = intCurRowID - intCurColID Then
    
43.             CanPlaced = False
    
44.             Exit Function
    
45.         End If
    
46.     Next
    
47.     CanPlaced = True
    
48. End Function
    
49. 
    
50. Sub GetResult()
    
51.     Dim lngCol As Long, lngRow As Integer
    
52.    
    
53.     If IsArray(arrResult) Then
    
54.         lngCol = UBound(arrResult, 2) + 1
    
55.         ReDim Preserve arrResult(1 To 8, 1 To lngCol) As Integer
    
56.     Else
    
57.         lngCol = 1
    
58.         ReDim arrResult(1 To 8, 1 To 1) As Integer
    
59.     End If
    
60.     For lngRow = LBound(Queen) To UBound(Queen)
    
61.         arrResult(lngRow, lngCol) = Queen(lngRow)
    
62.     Next
    
63. End Sub

复制代码

lsdongjh

楼上的有效性判断，基于下图所示

dongdonggege

学习留个名。