| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1235 人关注过本帖
标题:魔方阵 数组
只看楼主 加入收藏
hellowql
Rank: 2
来 自:安徽 合肥
等 级:论坛游民
帖 子:40
专家分:12
注 册:2009-4-25
结帖率:100%
收藏
已结贴  问题点数:0 回复次数:6 
魔方阵 数组
魔方阵问题:就是给一个数N(N>2),然后将1 到 N*N填入N*N的矩阵中,使每行、每列的和是一个常数,例如:
                                   8 1 6
                                   3 5 7      
                                   4 9 2
其实这是有公式的(分两大类,三小类),但是我不想使用公式,我想利用计算机的快速运算尝试最笨的方法,就是将这些数在每一位上试,我的方法很笨。下面是源码,和程序,我是人工输入的九个GOTO语句实现的,当N比较大时,不容易输入GOTO,所以请帮帮忙,谢谢。
Private Sub Form_Click()
Dim a(1 To 9) As Byte, p As Byte
For b = 1 To 9
    a(1) = b
    For c = 1 To 9
        a(2) = c
        If a(1) = a(2) Then GoTo c
        For d = 1 To 9
            a(3) = d
            If a(3) = a(1) Or a(3) = a(2) Or a(1) + a(2) + a(3) <> 15 Then GoTo d
            For e = 1 To 9
                a(4) = e
                    For l = 1 To 3
                        If a(4) = a(l) Then GoTo e
                    Next
                For f = 1 To 9
                    a(5) = f
                        For l = 1 To 4
                            If a(5) = a(l) Then GoTo f
                        Next
                    For g = 1 To 9
                        a(6) = g
                            For l = 1 To 5
                                If a(6) = a(l) Or a(4) + a(5) + a(6) <> 15 Then GoTo g
                            Next
                        For h = 1 To 9
                            a(7) = h
                                For l = 1 To 6
                                    If a(7) = a(l) Or a(1) + a(4) + a(7) <> 15 Then GoTo h
                                Next
                            For i = 1 To 9
                                a(8) = i
                                    For l = 1 To 7
                                        If a(8) = a(l) Or a(2) + a(5) + a(8) <> 15 Then GoTo i
                                    Next
                                For j = 1 To 9
                                    a(9) = j
                                    For l = 1 To 8
                                        If a(9) = a(l) Or a(7) + a(8) + a(9) <> 15 Or a(3) + a(6) + a(9) <> 15 Then
                                            GoTo j
                                        Else
                                            For m = 1 To 9
                                                Text1.Text = Text1.Text & a(m)
                                                If m Mod 3 = 0 Then Text1.Text = Text1.Text & vbCrLf
                                            Next
                                            p = p + 1
                                            Text1.Text = Text1.Text & vbCrLf
                                            Exit For
                                        End If
                                    Next
j:
                                Next
i:
                            Next
h:
                        Next
g:
                    Next
f:
                Next
e:
            Next
d:
        Next
c:
    Next
Next
MsgBox "一共有" & p & "组", vbOKOnly, "提示"
End Sub
魔方阵.rar (1.4 KB)
搜索更多相关主题的帖子: 魔方 
2009-12-18 12:09
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:4 

2 7 6
9 5 1
4 3 8
----------
2 9 4
7 5 3
6 1 8
----------
4 3 8
9 5 1
2 7 6
----------
4 9 2
3 5 7
8 1 6
----------
6 1 8
7 5 3
2 9 4
----------
6 7 2
1 5 9
8 3 4
----------
8 1 6
3 5 7
4 9 2
----------
8 3 4
1 5 9
6 7 2
----------
共 8 组结果

授人于鱼,不如授人于渔
早已停用QQ了
2009-12-20 19:26
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:8 
Private Sub Command1_Click()
Dim a As Long, b As Long, c As Long, d As Long
Dim e As Long, f As Long, g As Long, h As Long, i As Long
Dim j As Long
Dim k As Long, m As Long
Dim n(1 To 9) As Long
Dim p As String

p = ""
'9个循环变量
For a = 1 To 9
    Label1.Caption = a          '进度
    DoEvents
    n(1) = a
    For b = 1 To 9
    n(2) = b
    If Not IS重复(2, n()) Then      '测试是否重复
        For c = 1 To 9
            n(3) = c
            If Not IS重复(3, n()) Then      '测试是否重复
            For d = 1 To 9
                n(4) = d
                If Not IS重复(4, n()) Then      '测试是否重复
                For e = 1 To 9
                    n(5) = e
                    If Not IS重复(5, n()) Then      '测试是否重复
                    For f = 1 To 9
                        n(6) = f
                        If Not IS重复(6, n()) Then      '测试是否重复
                        For g = 1 To 9
                            n(7) = g
                            If Not IS重复(7, n()) Then      '测试是否重复
                            For h = 1 To 9
                                n(8) = h
                                If Not IS重复(8, n()) Then      '测试是否重复
                                For i = 1 To 9
                                    n(9) = i
                                    If Not IS重复(9, n()) Then      '测试是否重复
                                        k = 0
                                    
                                    If k = 0 Then           '
                                        j = a + b + c               '第一行
                                        'If e = 3 Then Stop
                                        If j <> d + e + f Then      '第二行
                                            k = 1
                                        ElseIf j <> g + h + i Then  '第三行
                                            k = 1
                                        ElseIf j <> a + d + g Then  '第一列
                                            k = 1
                                        ElseIf j <> b + e + h Then  '第二列
                                            k = 1
                                        ElseIf j <> c + f + i Then  '第三列
                                            k = 1
                                        ElseIf j <> a + e + i Then  '第一对角线
                                            k = 1
                                        ElseIf j <> c + e + g Then  '第二对角线
                                            k = 1
                                        End If
                                        If k = 0 Then       '成功一组
                                            m = m + 1       '计数

                                            '把结果放到文本框中
                                            p = p & vbCrLf
                                            p = p & a & " " & b & " " & c & vbCrLf
                                            p = p & d & " " & e & " " & f & vbCrLf
                                            p = p & g & " " & h & " " & i & vbCrLf
                                            p = p & "----------"
                                            Text1.Text = p
                                            
                                            DoEvents
                                        End If
                                       
                                    End If
                                    End If
                                Next i
                                End If
                            Next h
                            End If
                        Next g
                        End If
                    Next f
                    End If
                Next e
                End If
            Next d
            End If
        Next c
        End If
    Next b
Next a

p = p & vbCrLf
p = p & "共 " & m & " 组结果"
Text1.Text = p

MsgBox "共 " & m & " 组结果"

End Sub


Public Function IS重复(cs As Long, n() As Long) As Boolean
Dim o1 As Long

'初始化为不重复
IS重复 = False
'查找最后一个数据是否与前面的数据相同
For o1 = 1 To cs - 1
        If n(o1) = n(cs) Then   '找到相同,
            IS重复 = True       '重复了
            Exit For
        End If
Next o1

End Function

授人于鱼,不如授人于渔
早已停用QQ了
2009-12-20 19:27
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:8 
另一种形式的 是否重复函数参数传递方式.
注:此种形式的参数,会造成程序运行速度下降,但这种形式在数据不是一个数组的情况下很有用.

------------代码开始----------------
Private Sub Command2_Click()
Dim a As Long, b As Long, c As Long, d As Long
Dim e As Long, f As Long, g As Long, h As Long, i As Long
Dim j As Long
Dim k As Long, m As Long
Dim n(1 To 9) As Long
Dim p As String

p = ""
'9个循环变量
For a = 1 To 9
    Label1.Caption = a          '进度
    DoEvents
    For b = 1 To 9
    If Not is重复2(b, a) Then      '测试是否重复
        For c = 1 To 9
            If Not is重复2(c, a, b) Then     '测试是否重复
            For d = 1 To 9
                If Not is重复2(d, a, b, c) Then   '测试是否重复
                For e = 1 To 9
                    If Not is重复2(e, a, b, c, d) Then  '测试是否重复
                    For f = 1 To 9
                        If Not is重复2(f, a, b, c, d, e) Then '测试是否重复
                        For g = 1 To 9
                            If Not is重复2(g, a, b, c, d, e, f) Then '测试是否重复
                            For h = 1 To 9
                                If Not is重复2(h, a, b, c, d, e, f, g) Then '测试是否重复
                                For i = 1 To 9
                                    If Not is重复2(i, a, b, c, e, d, e, f, g, h) Then '测试是否重复
                                        k = 0
                                    
                                    If k = 0 Then           '
                                        j = a + b + c               '第一行
                                        'If e = 3 Then Stop
                                        If j <> d + e + f Then      '第二行
                                            k = 1
                                        ElseIf j <> g + h + i Then  '第三行
                                            k = 1
                                        ElseIf j <> a + d + g Then  '第一列
                                            k = 1
                                        ElseIf j <> b + e + h Then  '第二列
                                            k = 1
                                        ElseIf j <> c + f + i Then  '第三列
                                            k = 1
                                        ElseIf j <> a + e + i Then  '第一对角线
                                            k = 1
                                        ElseIf j <> c + e + g Then  '第二对角线
                                            k = 1
                                        End If
                                        If k = 0 Then       '成功一组
                                            m = m + 1       '计数

                                            '把结果放到文本框中
                                            p = p & vbCrLf
                                            p = p & a & " " & b & " " & c & vbCrLf
                                            p = p & d & " " & e & " " & f & vbCrLf
                                            p = p & g & " " & h & " " & i & vbCrLf
                                            p = p & "----------"
                                            Text1.Text = p
                                            
                                            DoEvents
                                        End If
                                       
                                    End If
                                    End If
                                Next i
                                End If
                            Next h
                            End If
                        Next g
                        End If
                    Next f
                    End If
                Next e
                End If
            Next d
            End If
        Next c
        End If
    Next b
Next a

p = p & vbCrLf
p = p & "共 " & m & " 组结果"
Text1.Text = p

MsgBox "共 " & m & " 组结果"

End Sub

Public Function is重复2(cs As Long, ParamArray n() As Variant) As Boolean

Dim o1 As Long
is重复2 = False
For o1 = 0 To UBound(n)
    If n(o1) = cs Then
        is重复2 = True
        Exit For
    End If
Next o1

End Function

授人于鱼,不如授人于渔
早已停用QQ了
2009-12-20 19:35
hellowql
Rank: 2
来 自:安徽 合肥
等 级:论坛游民
帖 子:40
专家分:12
注 册:2009-4-25
收藏
得分:0 
回复 4楼 风吹过b
谢谢,但是这个代码也是太多了,我想能不能用一个递归或是分块方式编写,因为其中很多是重复代码。可行吗?
2009-12-20 22:54
hellowql
Rank: 2
来 自:安徽 合肥
等 级:论坛游民
帖 子:40
专家分:12
注 册:2009-4-25
收藏
得分:0 
这是我最新想出来的方法,大家看看,有兴趣给我点意见:
程序代码:
'sum是计算行或者列以及对角线的
'stsum是计算行或者列合理的和,例如N=3时,stsum=15
'tim是计时的
'n是行数,n2是整个行列中最大数
'i是循环变量
'start保存上一个数,用于回退的,下面介绍
Private Sub Form_DblClick()
Dim sum As Byte, tim As Double, n As Byte, n2 As Byte, stsum As Byte, i As Byte, start As Byte
n = Val(Text1)
n2 = n * n
stsum = (1 + n2) * n / 2    '计算合理的行之和

ReDim GoBack(1 To n2) As Boolean    '为了在不满足条件下,能够回退到上一个数,例如a(1)=1,a(2)=2,a(3)=3,这时由于不符合,所以会使a(3)自加,然后到9时,到头了,所以要让a(2)自加,所以设置这个布尔量,为了让a(2)可以从2开始自加,这是用到了start否则,a(2)从1开始自加,又变成了2,程序不能进行下去.
ReDim a(1 To n2) As Byte

For x = 1 To n2
    GoBack(x) = False
Next

    tim = Timer
For i = 1 To n2
    If GoBack(i) = True Then
        start = a(i) + 1            'start使数组取向下一个数
        If start > n2 Then GoTo label 'start到头了就再回退
    Else
        start = 1
    End If
    For l = start To n2
        a(i) = l
        For k = 1 To i - 1
            If a(i) = a(k) Then Exit For
        Next
        If (k = i) Then Exit For

label:
        If i > 1 And (l = n2 Or start > n2) Then GoBack(i - 1) = True: i = i - 2: GoTo out                      '控制回退
    Next
    
    If i = n2 - n + 1 Then                                                                                      '进行判断行列是否满足条件,分四种情况,分别是:右边满行,左边满列,左下角斜对角,右下角,斜对角
        sum = 0
        For m = n To i Step n - 1
            sum = sum + a(m)
        Next
        If sum <> stsum Then GoTo label
        
        sum = 0
        For m = 1 To i Step n
            sum = sum + a(m)
        Next
        If sum <> stsum Then GoTo label
    ElseIf i = n2 Then
        sum = 0
        For m = 1 To i Step n + 1
            sum = sum + a(m)
        Next
        If sum <> stsum Then GoTo label
        
        sum = 0
        For m = n2 - n + 1 To i
            sum = sum + a(m)
        Next
        If sum <> stsum Then GoTo label
        
        sum = 0
        For m = n To i Step n
            sum = sum + a(m)
        Next
        If sum <> stsum Then GoTo label
    ElseIf i Mod n = 0 Then
        sum = 0
        For m = i - n + 1 To i
            sum = sum + a(m)
        Next
        If sum <> stsum Then GoTo label
    ElseIf i > n2 - n + 1 Then
        sum = 0
        For m = i + n - n2 To i Step n
            sum = sum + a(m)
        Next
        If sum <> stsum Then GoTo label
    End If
        For b = i To n2                                                                                                             '防止回退后,下一项数字不可以任意取,例如a(4)=4,a(5)=6,a(6)=5,a(7)=1这时由于a(7)不合适,所以要回退,这时goback(6)=true,然后调整这三项,例如a(4)=6,a(5)=7,这时a(6)应该为2,但是由于goback(6)=true,所以a(6)只可以从6开始,所以不合适。应该从1开始搜索。
            GoBack(b) = False
        Next
out:

Next
tim = Timer - tim
Print "用时" & tim & "秒"
Print
For x = 1 To n
    For y = 1 To n
        Print Format(a((x - 1) * n + y), "@@@@@");
    Next
    Print
Next

End Sub

Private Sub Form_Load()
MsgBox "请在文本框内输入边数,双击窗体运行", vbOKOnly, "提示"
End Sub
魔方阵.rar (2.64 KB)

2009-12-25 22:32
hellowql
Rank: 2
来 自:安徽 合肥
等 级:论坛游民
帖 子:40
专家分:12
注 册:2009-4-25
收藏
得分:0 
回复 3楼 风吹过b
版主,有空帮我看看,给点意见,谢谢。
我这个程序只可以算出一组结果,其实结果是对称的,但我还是想都算出来。
2009-12-25 22:35
快速回复:魔方阵 数组
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.020064 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved