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

浮华、缠绕指尖 · 发表于 2014-3-28 15:47

VBA通过二个题目加深对数组赋值的理解-----蛇形矩阵和螺旋矩阵，详情见附件，答案会在面进行贴出

lsdongjh · 发表于 2014-3-28 17:10

粗粗编一个，不一定是最优的

Option Explicit
Public Enum DirectionEnum
ToRight = 0
ToDown = 1
ToUp = 2
ToLeft = 3
End Enum
'蛇形
Sub SnakeMatrix(X As Long, Y As Long, Optional Direction As DirectionEnum = 0)
Dim iX As Long
Dim iY As Long
Dim n As Long
Dim DT As DirectionEnum
ReDim mat(1 To X, 1 To Y) As Long
DT = Direction
iX = 1
iY = 1
n = 1
mat(1, 1) = 1
Do While n < X * Y
n = n + 1
If DT = 0 And (iY = 1 Or iX = X) Then
If iX < X Then
iX = iX + 1
Else
iY = iY + 1
End If
DT = 1
ElseIf DT = 1 And (iX = 1 Or iY = Y) Then
If iY < Y Then
iY = iY + 1
Else
iX = iX + 1
End If
DT = 0
ElseIf DT = 0 Then
iX = iX + 1
iY = iY - 1
ElseIf DT = 1 Then
iX = iX - 1
iY = iY + 1
End If
mat(iX, iY) = n
Loop
'显示
Dim TempTx As String
For iY = 1 To Y
For iX = 1 To X
Sheet1.Cells(iY, iX) = mat(iX, iY)
Next
Next
End Sub
'旋转
Sub RevolveMatrix(X As Long, Y As Long, Optional Direction As DirectionEnum = 0)
Dim iX As Long
Dim iY As Long
Dim n As Long
Dim DT As DirectionEnum
ReDim mat(1 To X, 1 To Y) As Long
DT = Direction
iX = 1
iY = 1
n = 1
mat(1, 1) = 1
Do While n < X * Y
n = n + 1
Select Case DT
Case 0
If iX = X Then
iY = iY + 1
DT = ToDown
Else
If mat(iX + 1, iY) = 0 Then
iX = iX + 1
Else
iY = iY + 1
DT = ToDown
End If
End If
Case 1
If iY = Y Then
iX = iX - 1
DT = ToLeft
Else
If mat(iX, iY + 1) = 0 Then
iY = iY + 1
Else
iX = iX - 1
DT = ToLeft
End If
End If
Case 2
If iY = 1 Then
iX = iX + 1
DT = ToRight
Else
If mat(iX, iY - 1) = 0 Then
iY = iY - 1
Else
iX = iX + 1
DT = ToRight
End If
End If
Case 3
If iX = 1 Then
iY = iY - 1
DT = ToUp
Else
If mat(iX - 1, iY) = 0 Then
iX = iX - 1
Else
iY = iY - 1
DT = ToUp
End If
End If
End Select
Debug.Print iX & " " & iY
mat(iX, iY) = n
Loop
'显示
Dim TempTx As String
For iY = 1 To Y
For iX = 1 To X
Sheet1.Cells(iY, iX) = mat(iX, iY)
Next
Next
End Sub

复制代码

浮华、缠绕指尖 · 发表于 2014-3-28 17:18

lsdongjh 发表于 2014-3-28 17:10
粗粗编一个，不一定是最优的

多谢支持，还可以再精减一些

浮华、缠绕指尖 · 发表于 2014-3-28 18:34

呵呵，简单的算法，自己再顶一个

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

不是吧。。。自己顶一个

jiminyanyan · 发表于 2014-3-29 13:36

参与的人不多呢，楼主直接上答案好了呢。。。

浮华、缠绕指尖 · 发表于 2014-3-29 15:59

汗~~没什么意思，都没几个人参与。。。我就贴一段蛇形那个的代码。。。算是抛砖引玉吧。。。

'蛇形矩阵
Sub test()
Dim arr()
Cells.Clear
n = InputBox("Please Enter an Integer:", "Inputbox") * 1
k = 1: i = 1
ReDim arr(1 To n, 1 To n)
Do While i <= n
j = 1
Do While j <= i
If i Mod 2 = 0 Then
arr(i + 1 - j, j) = k
arr(n + j - i, n + 1 - j) = n ^ 2 + 1 - k
Else
arr(j, i + 1 - j) = k
arr(n + 1 - j, n + j - i) = n ^ 2 + 1 - k
End If
k = k + 1
j = j + 1
Loop
i = i + 1
Loop
Range("A1").Resize(n, n) = arr
End Sub

复制代码

香川群子 · 发表于 2014-3-29 17:40

1. 螺旋形有两种，一种从外向里、一种从里向外。

当然如果考虑螺旋方向就会更多种，但如果思路清晰了，方向很容易改，所以方向不同不算新问题。

2. 蛇行就更多了，楼主那种是斜的，
其实更简单的蛇行是：
奇数行从左到右，
偶数行从右到左。

总之是连起来的贪吃蛇。

额呵呵

香川群子 · 发表于 2014-3-29 17:55

我以前解了一个【一笔画覆盖点阵】的题目，

其中一种就是从外向里进行螺旋。

因为要画图和画线，所以代码稍稍复杂了一点。
请看附件。

只要输出数组结果应该代码会简单一些，有空改写一下。

香川群子 · 发表于 2014-3-29 18:09

本帖最后由香川群子于 2014-3-29 18:32 编辑

我出的【左右蛇行】题目的代码非常简单。

Sub 左右蛇行() 'by kagawa
Dim h&, i&, j&, k&, l&, m&, n&
l = InputBox("列数l=")
m = InputBox("总数m=")
h = (m - 1) \ l + 1 '计算行数
ReDim d(h - 1, l - 1)
For i = 0 To h - 1
For j = 0 To l - 1
If m Then d(i, IIf(i Mod 2, l - j - 1, j)) = i * l + j + 1: m = m - 1 Else Exit For
'计算直到m=0时停止
Next
Next
[a1].CurrentRegion = ""
[a1].Resize(h, l) = d
End Sub

复制代码

事实上一句代码就解决了。→ 数组的行列位置计算是很见功力的。

IIf(i Mod 2, l - j - 1, j) → 偶数行时按照 l-j-1倒序写入、奇数行时按照 j 正序写入即可。

由于数组从0开始，所以 i mod 2 =0 在这里是奇数行、而 i mod 2 = 1 却是偶数行了。

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

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

评分