vba自动生成旋转数字序列

zopey

Sub main()
Cells.ClearContents
w = InputBox("请输入奇数维数！！！")

b = (w + 1) / 2
Cells(b, b) = 1

For i = 1 To w Step 2
    a = (i - 1) / 2
    For j = 0 To i - 2
        Cells(b + a, b - a).Offset(0, j) = i * (i - 0) + 0 - j
        Cells(b + a, b + a).Offset(-j, 0) = i * (i - 1) + 1 - j
        Cells(b - a, b + a).Offset(0, -j) = i * (i - 2) + 2 - j
        Cells(b - a, b - a).Offset(j, 0) = i * (i - 3) + 3 - j
    Next
Next

End Sub

ctp_119

zopey 发表于 2018-9-10 10:16
Sub main()
Cells.ClearContents
w = InputBox("请输入奇数维数！！！")

这方法奇特！！！好！！！好好学习

香川群子

以前讨论过了。
http://club.excelhome.net/thread-1109068-1-1.html

zopey

香川群子 发表于 2018-9-10 11:16
以前讨论过了。
http://club.excelhome.net/thread-1109068-1-1.html

四角同时推进算法，这名字比较形象。

ctp_119

香川群子 发表于 2018-9-10 11:16
以前讨论过了。
http://club.excelhome.net/thread-1109068-1-1.html

哦，以前就有了！！！呵呵，，，不好意思，，，不过还是有学习的价值！！！

一把小刀闯天下

'参与一下
Option Explicit

Const NUM As Long = 21

Sub test()
  Dim i As Long, j As Long, k As Long
  Dim a As Long, b As Long, m As Long, cnt As Long
  If NUM Mod 2 = 0 Then MsgBox "!": Exit Sub
  ReDim arr(1 To NUM, 1 To NUM) As Long
  a = NUM: b = 1: m = NUM ^ 2: cnt = NUM
  For i = NUM ^ 2 To 2 Step -1
      For j = 1 To 4
        For k = 1 To cnt - 1
          arr(a, b) = m: m = m - 1
          Select Case j
          Case 1: b = b + 1
          Case 2: a = a - 1
          Case 3: b = b - 1
          Case 4: a = a + 1
          End Select
      Next k, j
      b = b + 1: a = a - 1: cnt = cnt - 2: i = m + 1
  Next
  arr(a, b) = m
  ActiveSheet.UsedRange.ClearContents
  [a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

lujkhua

zopey 发表于 2018-9-10 11:44
四角同时推进算法，这名字比较形象。

多数人叫  四方图  或  四方跑马灯

lsdongjh

也湊个热闹，支持顺时、逆时，支持任意步长，支持任意方向……

1. '顺时针起始方向
   
2. Enum Clockwise_Start
   
3.     Top = 0
   
4.     Right = 1
   
5.     Bottom = 2
   
6.     Left = 3
   
7. End Enum
   
8. '逆时针起始方向
   
9. Enum AntiClockwise_Start
   
10.     Top = 0
    
11.     Right = 3
    
12.     Bottom = 2
    
13.     Left = 1
    
14. End Enum
    
15. 
    
16. Const Clockwise  As String = "T,R,B,L,T,R,B,L" '顺时针方向
    
17. Const AntiClockwise  As String = "T,L,B,R,T,L,B,R" '逆时针方向
    
18. 
    
19. Dim lngStartNum As Long '数字初始值
    
20. Dim lngStep As Long '步长值
    
21. Dim lngRowID As Long, lngColID As Long '行列标号
    
22. Dim lngCount As Long '计数
    
23. Dim arrDirection()  As String   '运动方向数组
    
24. Dim curDirection As Integer '当前方向索引
    
25. Dim lngMax As Long '最大维度
    
26. Dim arrResult As Variant '结果集
    
27. Dim blIsOk As Boolean
    
28. Dim lngStepCount As Long
    
29. 
    
30. '主入口，测试
    
31. Sub Main()
    
32.     '从9开始的11*11矩阵
    
33.     lngMax = 11 '最大维度
    
34.     'arrDirection = SetDirection(AntiClockwise, AntiClockwise_Start.Top) '逆时针，先向上
    
35.     arrDirection = SetDirection(AntiClockwise, AntiClockwise_Start.Bottom) '逆时针，先向下
    
36.     curDirection = 0: lngStepCount = 1
    
37.     lngStartNum = 9: lngStep = 2 '初始为9，步长为2
    
38.     lngRowID = (lngMax + 1) / 2: lngColID = (lngMax + 1) / 2
    
39.     ReDim arrResult(1 To lngMax, 1 To lngMax) As Long
    
40.    
    
41.     arrResult(lngRowID, lngColID) = lngStartNum '中间填入初始值
    
42.     blIsOk = False
    
43.     Do Until blIsOk = True
    
44.         SetResult
    
45.     Loop
    
46.    
    
47.     Sheet1.Range("A1").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult
    
48.     MsgBox "OK"
    
49. End Sub
    
50. 
    
51. '运算过程
    
52. Function SetResult()
    
53.     Dim lngR As Long, lngC As Long
    
54. 
    
55.     For lngR = 1 To 2
    
56.         For lngC = 1 To lngStepCount
    
57.             lngCount = lngCount + 1
    
58.             If lngCount >= (lngMax ^ 2) Then
    
59.                 blIsOk = True
    
60.                 Exit Function
    
61.             End If
    
62.             lngStartNum = lngStartNum + lngStep
    
63.             Select Case arrDirection(curDirection)
    
64.                 Case "T"
    
65.                     lngRowID = lngRowID - 1
    
66.                 Case "B"
    
67.                     lngRowID = lngRowID + 1
    
68.                 Case "L"
    
69.                     lngColID = lngColID - 1
    
70.                 Case "R"
    
71.                     lngColID = lngColID + 1
    
72.             End Select
    
73.             arrResult(lngRowID, lngColID) = lngStartNum
    
74.         Next
    
75.         curDirection = (curDirection + 1) Mod 4
    
76.     Next
    
77.    
    
78.     lngStepCount = lngStepCount + 1
    
79. End Function
    
80. 
    
81. '返回运动方向
    
82. Function SetDirection(strDirection As String, intStartDir As Integer) As Variant
    
83.     Dim strT() As String, intI As Integer
    
84.     Dim arrTemp(0 To 3) As String
    
85.     strT = Split(strDirection, ",")
    
86.     For intI = 0 To 3
    
87.         arrTemp(intI) = strT(intStartDir + intI)
    
88.     Next
    
89.     SetDirection = arrTemp
    
90. End Function

复制代码

香川群子

zopey 发表于 2018-9-10 10:16
Sub main()
Cells.ClearContents
w = InputBox("请输入奇数维数！！！")

Sub main1()
    Cells.ClearContents
   
    n = InputBox("请输入方阵边长数n=(必须为奇数)", "生成内螺旋方阵", 11)
    r = (n + 1) / 2
   
    For i = n - 1 To 0 Step -2
        t = i / 2: m = (i + 1) * (i + 1)
        For j = 0 To i - 1
            Cells(r + t, r - t).Offset(0, j) = m - j
            Cells(r + t, r + t).Offset(-j, 0) = m - j - i
            Cells(r - t, r + t).Offset(0, -j) = m - j - 2 * i
            Cells(r - t, r - t).Offset(j, 0) = m - j - 3 * i
        Next
    Next
    Cells(r, r) = 1

End Sub
Sub main2()
    Cells.ClearContents
   
    n = InputBox("请输入方阵边长数n=(必须为奇数)", "生成外螺旋方阵", 11)
    r = (n + 1) / 2
   
    For i = n - 1 To 0 Step -2
        t = i / 2: m = (n + i + 1) * (n - i - 1) + 1
        For j = 0 To i - 1
            Cells(r + t, r - t).Offset(0, j) = m + j
            Cells(r + t, r + t).Offset(-j, 0) = m + j + i
            Cells(r - t, r + t).Offset(0, -j) = m + j + 2 * i
            Cells(r - t, r - t).Offset(j, 0) = m + j + 3 * i
        Next
    Next
    Cells(r, r) = n * n
   
End Sub

借用你的代码，修改一下，分别生成内螺旋方阵，和外螺旋方阵。

如果一步一步走，更清晰地看到数字的递增、递减变化。

鄂龙蒙

请老师帮助，谢谢！
http://club.excelhome.net/thread-1437934-1-1.html