EXCEL VBA]EXCEL中用递归实现任意n(3≤n≤256)阶幻方
2006-09-28 22:04
441 查看
下面代码将实现任意n(3≤n≤256)阶幻方,显示在EXCEL的 A1:IV256中
Sub magicsquare(ByVal n As Long, ByRef matrix())
Dim i As Long, j As Long, k As Long, p As Long, a(), temp As New Collection
ReDim matrix(1 To 256, 1 To 256)
If n < 3 Then MsgBox "n must be larger than 2! ": Exit Sub
If n Mod 4 = 0 Then
ReDim a(1 To n, 1 To n)
ReDim b(1 To n, 1 To n)
For i = 1 To n
For j = 1 To n
matrix(i, j) = IIf((i Mod 4) / 2 = (j Mod 4) / 2, n * n + 1 - (i - 1) * n - j, (i - 1) * n + j)
Next
Next
Else
If n Mod 4 = 2 Then
p = n / 2
ReDim a(1 To p, 1 To p)
magicsquare p, a
For i = 1 To p
For j = 1 To p
matrix(i, j) = a(i, j)
matrix(i + p, j) = a(i, j) + 3 * p * p
matrix(i, j + p) = a(i, j) + 2 * p * p
matrix(i + p, j + p) = a(i, j) + p * p
Next
Next
For i = 1 To (n - 2) / 4
temp.Add i
Next
For i = 3 * (n - 2) / 4 + 1 To n
temp.Add i
Next
For i = 1 To p
For j = 1 To temp.Count
k = matrix(i, temp(j))
matrix(i, temp(j)) = matrix(i + p, temp(j))
matrix(i + p, temp(j)) = k
Next
Next
Else
For j = 0 To n - 1
For i = 0 To n - 1
If j = 0 Then matrix(j + 1, i + 1) = IIf(i >= (n - 1) / 2, 0, n * (n + 1)) + (i - (n - 1) / 2) * (n + 2) + 1
If j > 0 Then matrix(j + 1, i + 1) = 1 + (n * n + matrix(j, i + 1) + IIf(matrix(j, i + 1) Mod n = 0, 0, n)) Mod n ^ 2
Next
Next
End If
End If
End Sub
Sub makemagicsquare()
Dim arr(), n As Long
Randomize
n = CLng(InputBox("please enter an integer", "infomation", 3+Int(Rnd*254)))
magicsquare n, arr
Range("a1").Resize(256, 256) = arr
Range("a1").Resize(256, 256).Columns.AutoFit
End Sub
Sub magicsquare(ByVal n As Long, ByRef matrix())
Dim i As Long, j As Long, k As Long, p As Long, a(), temp As New Collection
ReDim matrix(1 To 256, 1 To 256)
If n < 3 Then MsgBox "n must be larger than 2! ": Exit Sub
If n Mod 4 = 0 Then
ReDim a(1 To n, 1 To n)
ReDim b(1 To n, 1 To n)
For i = 1 To n
For j = 1 To n
matrix(i, j) = IIf((i Mod 4) / 2 = (j Mod 4) / 2, n * n + 1 - (i - 1) * n - j, (i - 1) * n + j)
Next
Next
Else
If n Mod 4 = 2 Then
p = n / 2
ReDim a(1 To p, 1 To p)
magicsquare p, a
For i = 1 To p
For j = 1 To p
matrix(i, j) = a(i, j)
matrix(i + p, j) = a(i, j) + 3 * p * p
matrix(i, j + p) = a(i, j) + 2 * p * p
matrix(i + p, j + p) = a(i, j) + p * p
Next
Next
For i = 1 To (n - 2) / 4
temp.Add i
Next
For i = 3 * (n - 2) / 4 + 1 To n
temp.Add i
Next
For i = 1 To p
For j = 1 To temp.Count
k = matrix(i, temp(j))
matrix(i, temp(j)) = matrix(i + p, temp(j))
matrix(i + p, temp(j)) = k
Next
Next
Else
For j = 0 To n - 1
For i = 0 To n - 1
If j = 0 Then matrix(j + 1, i + 1) = IIf(i >= (n - 1) / 2, 0, n * (n + 1)) + (i - (n - 1) / 2) * (n + 2) + 1
If j > 0 Then matrix(j + 1, i + 1) = 1 + (n * n + matrix(j, i + 1) + IIf(matrix(j, i + 1) Mod n = 0, 0, n)) Mod n ^ 2
Next
Next
End If
End If
End Sub
Sub makemagicsquare()
Dim arr(), n As Long
Randomize
n = CLng(InputBox("please enter an integer", "infomation", 3+Int(Rnd*254)))
magicsquare n, arr
Range("a1").Resize(256, 256) = arr
Range("a1").Resize(256, 256).Columns.AutoFit
End Sub
相关文章推荐
- EXCEL VBA]EXCEL中用递归实现任意n(3≤n≤256)阶幻方
- VBA实现任意n阶幻方的一种填法(n≥3)
- VBA实现任意n阶幻方的一种填法(n≥3)
- 通过VBA实现Excel纵向跨越合并单元格
- 用VBA实现把多个Excel文件合并到一个Excel文件的多个工作表(Sheet)里
- 利用递归调用实现十进制转化成任意进制
- 产生任意奇数阶幻方 三种方法实现
- EXCEL vba 实现通过超链接跳转到隐藏工作表 回到目录隐藏打开工作表
- 用VBA在EXCEL中实现九九乘法表制作,并加上边框
- Excel中用VBA链接Oracle实现位置随意标题
- (word,excel) vba 终止/杀掉/关掉/kill 任意进程(包括word,excel)
- 运用递归思想实现剪切任意文件夹
- 用VBA实现excel与access数据库交互
- 【VBA研究】用VBA取得EXCEL任意列有效行数
- 如何使用VBA实现将多个Excel文件中的数据复制到某个Excel文件中
- BugFree Excel格式化VBA实现
- Access 在VBA中实现数据导出到Excel
- 关于Excel下通过VBA实现工作簿文件下工作表的合并
- [原创]VBA实现汇总excel,将多个Excel文件内容复制到一个Excel文件中
- Excel VBA密码破解工具(VBA实现)