How to get the array like this?

Á

Á÷ÀËµÄË«Óã

I want to use VBA to make an array like the following.
Can anyone give me any advice?
Thanks!

57 58 59 60 61 62 63 64 65
56 31 32 33 34 35 36 37 66
55 30 13 14 15 16 17 38 67
54 29 12 03 04 05 18 39 68
53 28 11 02 01 06 19 40 69
52 27 10 09 08 07 20 41 70
51 26 25 24 23 22 21 42 71
50 49 48 47 46 45 44 43 72
81 80 79 78 77 76 75 74 73

D

why?

C

Chip Pearson

It is certainly possible. Code like the following may get you started.

Sub AAA()
Dim NumRows As Long
Dim NumCols As Long
Dim RNdx As Long
Dim CNdx As Long

NumRows = 3
NumCols = 6
For RNdx = 1 To NumRows
For CNdx = 1 To NumCols
Cells(RNdx, CNdx).Value = "????"
Next CNdx
Next RNdx
End Sub

The big question, of course, is how are the individual values
calculated? What would you have go in place of the ???? in the code
above.

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

H

Harlan Grove

Á÷ÀËµÄË«Óã said:
I want to use VBA to make an array like the following.
Can anyone give me any advice?

57 58 59 60 61 62 63 64 65
56 31 32 33 34 35 36 37 66
55 30 13 14 15 16 17 38 67
54 29 12 03 04 05 18 39 68
53 28 11 02 01 06 19 40 69
52 27 10 09 08 07 20 41 70
51 26 25 24 23 22 21 42 71
50 49 48 47 46 45 44 43 72
81 80 79 78 77 76 75 74 73

You have a spiral. Not immediately obvious to see, but you have a 9 by
9 array with 1 in the center at coordinates (5,5), increment left,
then up, then right 2 cells, then down 2 cells, then right 3 cells,
then up 3 cells, then right 4 cells, then down 4 cells, etc.

So if you want to move clockwise moving left first from the center, so
left - up - right - down, you could try the following udf.

Function spiral_lurd(ByVal n As Long) As Variant
Dim i As Long, j As Long, k As Long, m As Long, s As Long
Dim rv() As Long

If n < 1 Then
spiral_lurd = CVErr(xlErrNum)
Exit Function
End If

ReDim rv(1 To n, 1 To n)

i = 1 + n \ 2
j = i
k = 1
rv(i, j) = k

For m = 1 To n
s = IIf(m Mod 2 = 1, -1, 1)

Do While s * j < s * i + m
j = j + s
If j < 1 Or j > n Then Exit For
k = k + 1
rv(i, j) = k
Loop

Do While s * i < s * j
i = i + s
k = k + 1
rv(i, j) = k
Loop

Next m

spiral_lurd = rv

End Function

Select, say, F21:N29, type the formula =spiral_lurd(9), hold down
[Ctrl] and [Shift] keys and press [Enter] to enter the formula in
these cells as a single array formula.

H

Harlan Grove

Don Guillett said:

Why respond?

K

keiji kounoike

Try this one. this code will put the number as you showed into cells,
but not making an array as you said. if you want to make an array having
a number like this, you need to modify the code below a little.

Sub PutNumtest()
Dim J As Long, I As Long, M As Long
Dim n As Long, DL As Long, k As Long, R As Long
Dim sngJ As Long, sngI As Long

J = 5 '<<==change here if you want
I = 5 '<<==cahnge here if you want
n = 1
Cells(I, J) = n
sngJ = -1
sngI = -1
M = 1

On Error GoTo ex
Do
For k = 0 To 1
If DL = 0 Then
For R = 1 To M
n = n + 1
J = J + sngJ
Cells(I, J) = n
Next
sngJ = -sngJ
DL = 1
Else
For R = 1 To M
n = n + 1
I = I + sngI
Cells(I, J) = n
Next
sngI = -sngI
DL = 0
End If
Next
M = M + 1
Loop
ex:
End Sub

Keiji