楼主
liuguansky |
Q：如何生成单偶阶魔方阵？[即魔方阶数为4N+2形式]
A：依罗伯填充法生成：
- Sub justtest() '单偶阶魔方[罗伯法]
- Dim arr() As Long, n&, i&, m&, j&, row&, col&, arrre() As Long, k&
- s = Application.InputBox("请输入单偶整数即4N+2形式", "4N+2整数输入：", 10)
- If s Mod 4 = 2 Then
- n = s / 2
- ReDim arr(1 To n, 1 To n)
- i = 1: m = n ^ 2: row = 1: col = (n + 1) / 2
- Do While i <= m
- If row = 0 Then row = n
- If col = n + 1 Then col = 1
- arr(row, col) = i
- If i Mod n = 0 Then
- row = row + 1
- Else
- row = row - 1
- col = col + 1
- End If
- i = i + 1
- Loop
- ReDim arrre(1 To s, 1 To s)
- For i = 1 To s
- For j = 1 To s
- arrre(i, j) = arr((i - 1) Mod n + 1, (j - 1) Mod n + 1) + IIf(i > n Or j > n, (2 - IIf(j > n, 1, -1) + IIf(i <= n, 1, 0)) * n ^ 2, 0)
- Next j, i
- For i = 1 To n
- For j = 1 To n
- If (j < n / 2 And i <> (n + 1) / 2) Or (j > n / 2 And j < n And i = (n + 1) / 2) Then
- k = arrre(i, j)
- arrre(i, j) = arrre(i + n, j)
- arrre(i + n, j) = k
- End If
- Next j, i
- u = (n - 1) / 2
- If u > 1 Then
- For i = 1 To n
- For j = n + 2 To n + u
- k = arrre(i, j)
- arrre(i, j) = arrre(i + n, j)
- arrre(i + n, j) = k
- Next j, i
- End If
- Cells.Clear
- With Cells(1, 1).Resize(s, s)
- .Value = arrre
- End With
- Else: Exit Sub
- End If
- With Cells(1, 1) '验证结果
- .Offset(s + 1, 0).Resize(1, s) = "=sum(r[-" & s + 1 & "]c:r[-1]c)"
- .Offset(0, s + 1).Resize(s, 1) = "=sum(rc[-" & s + 1 & "]:rc[-1])"
- For i = 1 To s
- For j = 1 To s
- If i = j Then .Offset(s, s) = .Offset(s, s) + arrre(i, j)
- If i + j = s + 1 Then .Offset(s + 1, s + 1) = .Offset(s + 1, s + 1) + arrre(i, j)
- Next j, i
- .Resize(1, s + 2).EntireColumn.AutoFit
- End With
- End Sub
|