求关于九宫图的最佳算法，高手们请试试。

northwolves 2003-03-12 02:55:52

在一个矩形表格内添上一个从一到N位数，使其每列，每行个矩格和两条交叉线上几个数相加之和均相等。如：将1-9分别添如下列框中
1 2 3
4 5 6
7 8 9
变成
2 9 4
7 5 3
6 1 8
几个数之和均需要是相等的，等于15

这是我用穷举法找做的程序,大家看看有没有什么更好的方法实现呀:

在界面上放9个Text控件(数组)T(1) ---T(9) 和一个Command控件名为Command1 代码如下:

Option Explicit

Private Sub Command1_Click()
Dim i1 As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim i4 As Integer
Dim i5 As Integer
Dim i6 As Integer
Dim i7 As Integer
Dim i8 As Integer
Dim i9 As Integer
Dim strTmp As String
'2 9 4
'7 5 3
'6 1 8
For i1 = 1 To 9
T(1) = i1
strTmp = "0" & i1
For i2 = 1 To 9
strTmp = "0" & i1
If InStr(1, strTmp, i2) = 0 Then
T(2) = i2
strTmp = "0" & i1 & i2
For i3 = 1 To 9
strTmp = "0" & i1 & i2
If InStr(1, strTmp, i3) = 0 Then
T(3) = i3
strTmp = "0" & i1 & i2 & i3
For i4 = 1 To 9
strTmp = "0" & i1 & i2 & i3
If InStr(1, strTmp, i4) = 0 Then
T(4) = i4
strTmp = "0" & i1 & i2 & i3 & i4
For i5 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4
If InStr(1, strTmp, i5) = 0 Then
T(5) = i5
strTmp = "0" & i1 & i2 & i3 & i4 & i5
For i6 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4 & i5
If InStr(1, strTmp, i6) = 0 Then
T(6) = i6
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6
For i7 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6
If InStr(1, strTmp, i7) = 0 Then
T(7) = i7
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6 & i7
For i8 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6 & i7
If InStr(1, strTmp, i8) = 0 Then
T(8) = i8
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6 & i7 & i8
For i9 = 1 To 9
strTmp = "0" & i1 & i2 & i3 & i4 & i5 & i6 & i7 & i8
If InStr(1, strTmp, i9) = 0 Then
T(9) = i9
If Val(T(1)) + Val(T(2)) + Val(T(3)) = 15 Then
If Val(T(1)) + Val(T(4)) + Val(T(7)) = 15 Then
If Val(T(2)) + Val(T(5)) + Val(T(8)) = 15 Then
If Val(T(3)) + Val(T(6)) + Val(T(9)) = 15 Then
If Val(T(4)) + Val(T(5)) + Val(T(6)) = 15 Then
If Val(T(7)) + Val(T(8)) + Val(T(9)) = 15 Then
If Val(T(1)) + Val(T(5)) + Val(T(9)) = 15 Then
If Val(T(3)) + Val(T(5)) + Val(T(7)) = 15 Then
MsgBox "用穷举法找到了!"
Exit Sub
End If
End If
End If
End If
End If
End If
End If
End If
End If
DoEvents
Next i9
End If
Next i8
End If
Next i7
End If
Next i6
End If
Next i5
End If
Next i4
End If
Next i3
End If
Next i2
Next i1
End Sub

...全文

182 4 打赏收藏转发到动态举报

写回复

用AI写文章

4 条回复

切换为时间正序

请发表友善的回复…

发表回复

northwolves 2003-03-16

打赏
举报

问题已解决，结贴。

northwolves 2003-03-12

打赏
举报

'楼主的程序......一眼望去真是不得了

'多谢夸奖，这是从某论坛上见到的，我没调试过，因为。。。。。我晕倒了。

'下面是我曾写过的奇数阶幻方,但问题是如何列出所有可能排列？穷举法似乎不易。

Sub huanfang(ByVal n As Integer) '一维数组
Me.Caption = n & " 阶幻方"
ForeColor = vbRed
Dim num() As Integer
ReDim num(n ^ 2 - 1) As Integer
If n Mod 2 = 0 Then Exit Sub
For i = 0 To n ^ 2 - 1
If i < n Then
num(i) = IIf(i >= (n - 1) / 2, 0, n * (n + 1)) + (i - (n - 1) / 2) * (n + 2) + 1
Else
num(i) = 1 + (n ^ 2 + num(i - n) + IIf(num(i - n) Mod n = 0, 0, n)) Mod n ^ 2
End If
Print Tab((i Mod n) * 6); Space(4 - Len(Str(num(i)))) & num(i);
If (i + 1) Mod n = 0 Then Print
Next
End Sub
Private Sub Form_Click()
huanfang 19
End Sub