vba自动生成旋转数字序列

ctp_119

先看示意图：



发帖本意：
       看见超版用函数做出来了，很是惊奇！非常佩服！！！这个函数都可以做出来，那我vba呢？答案是肯定的！！！可是要如何实现呢？
今天是星期天，加班，办公室人少，中午本来午休的，可是禁不住要思考！！！于是就琢磨着：功夫不负有心人……
希望有其他好的方法，大家共享学习！！！
下面是超版的函数版附件：

旋转数字序列-超人.rar (22.66 KB, 下载次数: 85)

2018-9-9 16:40 上传

点击文件名下载附件

ctp_119

这是我vba实现的代码：

1. Sub main()
   
2. Dim s As Integer
   
3. Dim i As Integer
   
4. Dim a As Integer
   
5. Dim c As Integer
   
6. Dim w As Integer
   
7. Dim d As Integer
   
8. Dim ii As Integer
   
9. Dim h As Integer
   
10. Application.ScreenUpdating = False
    
11. Cells.ClearContents
    
12. w = InputBox("请输入奇数维数！！！")
    
13. s = w * w
    
14. i = (w + 1) / 2
    
15. b = w
    
16. For a = w To i Step -1
    
17. 1000:
    
18.     For c = 1 To b
    
19.         If Cells(a, c) = "" Then
    
20.             Cells(a, c) = s
    
21.             s = s - 1
    
22.             If s = 0 Then Exit Sub
    
23.         End If
    
24.     Next c
    
25.     a = a - 1
    
26.     GoTo 100
    
27. Next a
    
28. 100:
    
29. For d = VBA.IIf(d, d, w) To i Step -1
    
30.     For e = b To 1 Step -1
    
31.         If Cells(e, d) = "" Then
    
32.             Cells(e, d) = s
    
33.             s = s - 1
    
34.             If s = 0 Then Exit Sub
    
35.         End If
    
36.     Next e
    
37.     d = d - 1
    
38.     GoTo 10
    
39. Next d
    
40. 10:
    
41. For h = VBA.IIf(h, h, 1) To i
    
42.     For g = w To 1 Step -1
    
43.         If Cells(h, g) = "" Then
    
44.             Cells(h, g) = s
    
45.             s = s - 1
    
46.             If s = 0 Then Exit Sub
    
47.         End If
    
48.     Next g
    
49.     h = h + 1
    
50.     GoTo 1:
    
51. Next h
    
52. 1:
    
53. For ii = VBA.IIf(ii, ii, 1) To i
    
54.     For jj = 1 To b
    
55.         If Cells(jj, ii) = "" Then
    
56.             Cells(jj, ii) = s
    
57.             s = s - 1
    
58.             If s = 0 Then Exit Sub
    
59.         End If
    
60.     Next jj
    
61.     ii = ii + 1
    
62.     GoTo 1000:
    
63. Next ii
    
64. Application.ScreenUpdating = True
    
65. End Sub
    

复制代码

没有什么高级的算法！！！搭积木堆砌而成！！！希望看见其他好的算法！！！

ctp_119

下面是我vba的附件：


vba自动生成旋转数字序列.rar (16.45 KB, 下载次数: 48)

2018-9-9 16:47 上传

点击文件名下载附件

jiminyanyan

版主重出江湖啦。。。

ctp_119

jiminyanyan 发表于 2018-9-9 20:59
版主重出江湖啦。。。

哈哈，一直都在！！！
只是后浪推前浪！！！

chxw68

1. Sub test()
   
2.   Dim i%, j%, m%, n%, w%
   
3.   Dim arr()
   
4.   w = Application.InputBox(prompt:="请输入奇数维数", Title:="操作提示", Default:=21, Type:=1)
   
5.   If w Mod 2 = 0 Then
   
6.     MsgBox "输入的维数不是奇数！"
   
7.     Exit Sub
   
8.   End If
   
9.   a = Int(w / 2) + 1
   
10.   ReDim arr(1 To w, 1 To w)
    
11.   m = a
    
12.   n = a
    
13.   For i = 1 To w ^ 2
    
14.     arr(m, n) = i
    
15.     If m >= a Then
    
16.       If n >= a Then
    
17.         If arr(m, n - 1) = "" Then
    
18.           n = n - 1
    
19.         Else
    
20.           m = m + 1
    
21.         End If
    
22.       Else
    
23.         If arr(m - 1, n) = "" Then
    
24.           m = m - 1
    
25.         Else
    
26.           n = n - 1
    
27.         End If
    
28.       End If
    
29.     Else
    
30.       If n < a Then
    
31.         If arr(m, n + 1) = "" Then
    
32.           n = n + 1
    
33.         Else
    
34.           m = m - 1
    
35.         End If
    
36.       Else
    
37.         If arr(m + 1, n) = "" Then
    
38.           m = m + 1
    
39.         Else
    
40.           n = n + 1
    
41.         End If
    
42.       End If
    
43.     End If
    
44.   Next
    
45.   With Worksheets("sheet1")
    
46.     .Cells.Clear
    
47.     .Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
48.     .Columns(1).Resize(, w).AutoFit
    
49.   End With
    
50. End Sub

复制代码

chxw68

看到版主对此题这么有兴趣，心手也非常痒痒，从昨天到今天一直琢磨，终于今天早晨实现要求，在此献丑了。

zopey

观察 1,9,25,49,81,121,169,225,... ...

正好是 奇数{1，3，5，7，9，11，13，15，...} 的平方值

ctp_119

chxw68 发表于 2018-9-10 08:56
看到版主对此题这么有兴趣，心手也非常痒痒，从昨天到今天一直琢磨，终于今天早晨实现要求，在此献丑了。

谢谢捧场！！！下载学习一下！！！

ctp_119

zopey 发表于 2018-9-10 08:57
观察 1,9,25,49,81,121,169,225,... ...

正好是 奇数{1，3，5，7，9，11，13，15，...} 的平方值

函数是超版做的，我没有深究，太复杂的函数，烧脑！！！