Excel–计算n阶单偶数幻方

单偶数幻方的算法，是所有幻方里面最难的。

至此，所有幻方的算法就讲完了，可以将所有算法合并到一起，成为万能幻方算法。只要在开头部分用 mod 函数判断阶数，调用相应的 VBA 模块即可。

奇数和双偶数幻方的算法及代码请参阅

下面再重复一下偶数幻方定义，以防大家忘记了：

1. 双偶阶幻方：n 为偶数，且能被 4 整除

n=4，8，12，16，20……

n=4k，k=1，2，3，4，5……

2. 单偶阶幻方：n 为偶数，且不能被4整除

n=6，10，14，18，22……

n=4k+2，k=1，2，3，4，5……

单偶阶幻方算法：

n 为偶数，且不能被 4 整除

n=6，10，14，18，22……

n=4k+2，k=1，2，3，4，5……

以 n=10 为例，此时，k=2

1. 把方阵分为如下 A、B、C、D 四个象限，每一个象限都是奇数幻方

2. 用罗伯法，按顺序在 A、B、C、D 象限填数

3. 自 A 象限的中间行、中间列开始，自左向右，标出 k 格。A 象限的其他行则标出最左边的 k 格

4. D 象限同上

5. 将 A、D 象限标出的这些格互换位置

6. 自 C 象限的中间列起，自右向左，标出 k-1 列

7. B 象限同上

* 注：6 阶幻方由于 k-1=0，所以不用再做 C、B 象限的数据交换

8. 将 C、B 象限标出的这些格互换位置，10 阶幻方即已完成

代码：

Sub 单偶数幻方填写_数组记录()

n = Val(InputBox("请输入[6]以上的单偶数:", "n 阶幻方的阶数", 10))'阶数输入框，默认输入10

If n Mod 4 2 Or n

[a1].CurrentRegion = ""

[a1].Resize(n, n).Select

'清空并选择填写区域

Dim x As Integer, k As Integer

ReDim a(1 To n, 1 To n)'定义数组

r = 1: c = (n / 2 + 1) / 2'A象限的第一行中间列

a(r, c) = 1'A象限填第一个数

a(r + n / 2, c) = 3 * (n / 2) ^ 2 + 1'D象限填第一个数

a(r, n / 2 + (n / 2 + 1) / 2) = 2 * (n / 2) ^ 2 + 1'C象限填第一个数

a(r + n / 2, n / 2 + (n / 2 + 1) / 2) = (n / 2) ^ 2 + 1'B象限填第一个数

For i = 2 To (n / 2) ^ 2'A象限的值

If r = 1 And c = n / 2 Then'小象限到第1行最末一列时

r = r + 1'去下一行

ElseIf r = 1 Then'小象限第1行，非最末一列时

r = n / 2: c = c + 1'到小象限最末行,列+1

ElseIf c = n / 2 Then'到小象限最末列时

r = r - 1: c = 1'去小象限内第1列,行-1

ElseIf a(r - 1, c + 1) Then'右上格已填不为空时

r = r + 1'去下一行

Else'其他

r = r - 1: c = c + 1'右上爬梯

End If

a(r, c) = i'A象限顺序填数

a(r + n / 2, c) = 3 * (n / 2) ^ 2 + i'D象限顺序填数

a(r, c + n / 2) = 2 * (n / 2) ^ 2 + i'C象限顺序填数

a(r + n / 2, c + n / 2) = (n / 2) ^ 2 + i'B象限顺序填数

Next

k = (n - 2) / 4'给k赋值

For c = (n / 2 + 1) / 2 To (n / 2 + 1) / 2 + (k - 1)'自 A 象限的中间列开始，自左向右，标出 k 列

r = (n / 2 + 1) / 2'A 象限的中间行

'与D象限的同等区域置换

x = a(r, c)

a(r, c) = a(r + n / 2, c)

a(r + n / 2, c) = x

Next

For c = 1 To k'自左向右，标出 k 列

For r = 1 To n / 2'A 象限的所有行

If r (n / 2 + 1) / 2 Then'扣除中间行

'与D象限的同等区域置换

x = a(r, c)

a(r, c) = a(r + n / 2, c)

a(r + n / 2, c) = x

End If

Next

Next

For c = (n / 2 + 1) / 2 + n / 2 - (k - 1) + 1 To (n / 2 + 1) / 2 + n / 2'自 C 象限的中间列起，自右向左，标出 k-1 列

For r = 1 To n / 2'C 象限的所有行

'与B象限的同等区域置换

x = a(r, c)

a(r, c) = a(r + n / 2, c)

a(r + n / 2, c) = x

Next

Next

Selection = a

End Sub

运行效果：

Excel学习世界

转发、在看也是爱！