VBA通过二个题目加深对数组赋值的理解-----蛇形矩阵和螺旋矩阵，详情见附件

香川群子 · 发表于 2014-3-29 20:33

螺旋形代码：

方向同End()参数的习惯。1、2、3、4为左右上下。
实际次序为2、4、1、3 即右、下、左、上的顺时针螺旋。

Sub test() 'by kagawa
[a1].CurrentRegion = ""
n = InputBox("n=", , 19)
ReDim a(1 To n, 1 To n)
m = n ^ 2
i1 = 1: i2 = 1: j1 = 1: j2 = n: r = 2
Do
For i = i1 To i2
For j = j1 To j2
k = k + 1
If r = 2 Then
a(i, j) = k
ElseIf r = 4 Then
a(i, j) = k
ElseIf r = 1 Then
a(i, n - j) = k
ElseIf r = 3 Then
a(n - i + 1, j) = k
End If
[a1].Resize(n, n) = a '这句产生动画效果要速度就注释掉
Next
Next
If r = 2 Then
j1 = j2: i2 = n - i1 + 1: i1 = i1 + 1: r = 4
ElseIf r = 4 Then
i1 = i2: j1 = n - j2 + 1: j2 = j2 - 1: r = 1
ElseIf r = 1 Then
j2 = j1: i1 = n - i2 + 2: i2 = i2 - 1: r = 3
ElseIf r = 3 Then
i2 = i1: j2 = n - j1: j1 = j1 + 1: r = 2
End If
Loop Until k = m
[a1].Resize(n, n) = a
[a1].Offset(i - 2, j - 2).Activate
End Sub

复制代码

香川群子 · 发表于 2014-3-29 20:35

或许能找到一个通用公式，即已知序号k，计算得到螺旋后的二维数组行、列位置。

这样虽然速度不可能快，但比较有趣。

香川群子 · 发表于 2014-3-30 00:22

改成顺时针、逆时针两个方向，矩阵大小设置为x行、y列。

Sub test1() 'by kagawa
Dim i&, j&, i1&, j1&, i2&, j2&, k&, m&, r&, x&, y&, z&
[a1].CurrentRegion = ""
x = InputBox("行数x=")
y = InputBox("列数y=")
z = MsgBox("顺时针Yes/逆时针No", vbYesNo)
ReDim a(1 To x, 1 To y)
m = x * y
i1 = 1: j1 = 1
If z = vbYes Then
i2 = 1: j2 = y: r = 2 '2-4-1-3
Else
i2 = x: j2 = 1: r = 4 '4-2-3-1
End If
Do
For i = i1 To i2
For j = j1 To j2
k = k + 1
If r Mod 2 Then
If r = 1 Then
If z = vbYes Then a(i, y - j) = k Else a(i, y - j + 1) = k
Else 'r=3
If z = vbYes Then a(x - i + 1, j) = k Else a(x - i, j) = k
End If
Else
a(i, j) = k
End If
[a1].Resize(x, y) = a
Next
Next
If k = m Then Exit Do
If r = 1 Then
If z = vbYes Then '2-4-1-3
j2 = j1: i1 = x - i2 + 2: i2 = i2 - 1: r = 3
Else '4-2-3-1-4
j2 = j1: i2 = x - i1: i1 = i1 + 1: r = 4
End If
ElseIf r = 2 Then
If z = vbYes Then '2-4-1-3
j1 = j2: i2 = x - i1 + 1: i1 = i1 + 1: r = 4
Else '4-2-3-1
j1 = j2: i1 = x - i2 + 1: i2 = i2 - 1: r = 3
End If
ElseIf r = 3 Then
If z = vbYes Then '2-4-1-3-2
i2 = i1: j2 = y - j1: j1 = j1 + 1: r = 2
Else '4-2-3-1
i2 = i1: j1 = y - j2 + 2: j2 = j2 - 1: r = 1
End If
ElseIf r = 4 Then
If z = vbYes Then '2-4-1-3
i1 = i2: j1 = y - j2 + 1: j2 = j2 - 1: r = 1
Else '4-2-3-1
i1 = i2: j2 = y - j1 + 1: j1 = j1 + 1: r = 2
End If
End If
Loop
[a1].Resize(x, y) = a
If r Mod 2 Then [a1].Offset(i1 - 1, j1 - 1).Activate Else [a1].Offset(i2 - 1, j2 - 1).Activate
End Sub

复制代码

浮华、缠绕指尖 · 发表于 2014-3-30 08:21

香川群子发表于 2014-3-29 18:09
我出的【左右蛇行】题目的代码非常简单。事实上一句代码就解决了。→ 数组的行列位置计算是很见功力的。

...

呵呵，谢谢裙子的参与，倍感荣幸啊，其实左右蛇行的，用公式就可以搞定的，http://club.excelhome.net/thread-1102841-1-1.html

浮华、缠绕指尖 · 发表于 2014-3-30 08:38

香川群子发表于 2014-3-30 00:22
改成顺时针、逆时针两个方向，矩阵大小设置为x行、y列。

方向和大小都可以通过变量来控制

141475046 · 发表于 2014-3-31 09:24

来试试
Sub Main()
Const Num As Integer = 10
Const k1 As Integer = 1 '1为顺时针，0为逆时针
Dim i As Integer, j As Integer
Dim r As Integer, c As Integer, n As Integer
Dim k2 As Integer
If k1 Then k2 = 0 Else k2 = 1
r = 1: c = 1: n = 1
Cells.Clear
For i = Num - 1 To 1 Step -2
      For j = 0 To i - 1
         Cells(r + j * k2, c + j * k1) = n
         Cells(r + j * k1 + i * k2, c + i * k1 + j * k2) = n + i
         Cells(r + i - j * k2, c + i - j * k1) = n + i * 2
         Cells(r + (i - j) * k1, c + (i - j) * k2) = n + i * 3
         n = n + 1
      Next
      n = n + i * 3
      r = r + 1: c = c + 1
Next
If Num Mod 2 Then Cells(r, c) = n
End Sub

浮华、缠绕指尖 · 发表于 2014-3-31 13:45

141475046 发表于 2014-3-31 09:24
来试试
Sub Main()
Const Num As Integer = 10

谢谢参与,当然最好是能写到数组里，这样看起来就更好了

香川群子 · 发表于 2014-3-31 13:55

经研究，螺旋矩阵算法可以大大地简化：

Sub test2() '顺时针螺旋 by kagawa
Dim x&, y&, i&, j&, k&, l&, n&, ii&, jj&
[a1].CurrentRegion = ""
x = InputBox("x=")
y = InputBox("y=")
ReDim a(1 To x, 1 To y)
i = 1: j = 0
r = Array(0, 1, 0, -1) '行列递增规律
If x > y Then n = y * 2 - 1 Else n = x * 2 - 2 '计算螺旋圈数
For t = 0 To n '按圈数遍历循环
ii = r(t Mod 4): jj = r((t + 1) Mod 4) '计算本圈螺旋的行增量ii、列增量jj
tt = (t + 1) \ 2 '计算本圈减少数
For l = 1 To IIf(t Mod 2, x - tt, y - tt) '按计算结果循环本圈
i = i + ii: j = j + jj '本次行列位置递增改变
k = k + 1: a(i, j) = k '对应位置写入序号k
[a1].Resize(x, y) = a '输出结果到工作表 (观察用) 要速度时注释掉
Next
Next
[a1].Resize(x, y) = a '输出到工作表
[a1].Offset(i - 1, j - 1).Activate '光标移动到当前结束位置即最大k位置
End Sub

复制代码

本代码的要点，就在于掌握了螺旋式行进时的行、列位置变化规律，以及行列位置的变化长度。

香川群子 · 发表于 2014-3-31 14:01

不使用行列增量变化数组r
直接计算也可以：

If t Mod 2 Then i2 = (-1) ^ ((t - 1) / 2) : j2 = 0 Else i2 = 0 : j2 = (-1) ^ (t / 2)

总体上相当于按照下面循环就直接计算出新的行列位置，然后直接赋值了。
For l = 1 To IIf(t Mod 2, x - tt, y - tt)
i = i + ii: j = j + jj
k = k + 1: a(i, j) = k
Next

所以这个算法应该是最直接的。

…………
逆时针螺旋应该可以按同样思路进行，但稍有不同。

浮华、缠绕指尖 · 发表于 2014-3-31 14:27

香川群子发表于 2014-3-31 13:55
经研究，螺旋矩阵算法可以大大地简化：本代码的要点，就在于掌握了螺旋式行进时的行、列位置变化规律，以及 ...

嗯，其实整体思路是没变的，你的代码的亮点在于辅助数组r=Array(0,1,0,-1)，这个用得是非常好，代替了他们用的case语句

		自动登录	找回密码
密码			免费注册

[讨论] VBA通过二个题目加深对数组赋值的理解-----蛇形矩阵和螺旋矩阵，详情见附件

评分

评分