[µo°Ý] ¦b¤è°}©Î¯x°}¤¤,¥H±ÛÂà¤è¦¡¶ñ¤J­È

­ã´£³¡ªL

¦b¤è°}©Î¯x°}¤¤,¥H±ÛÂà¤è¦¡¶ñ¤J­È

¢°¡D³]¤@­Ó¤è°}©Î¯x°}¬°5*5¡]¶·¦Ò¼{¥i¯à§ïÅܬ°7*7,9*9...)¡C
¢±¡D¥ô¿ï¤@­ÓÀx¦s®æ¬°¡e¤¤¤ßÂI¡f¡A¥H¦¹¤¤¤ßÂI¨Ì¡e¶¶®É°w¡f¤è¦V¡A¡e¥Ñ¤º¦Ó¥~¡f¶ñ¤J­È¡C

»Ý¨D®ÄªG¢°¡G¡@¡@¡@¡@¡@¡@¡@¡@¡@¡@»Ý¨D®ÄªG¢±¡G

¤U¸ü (41.85 KB)

2015-10-24 17:12

¡@¡@¡@¡@

¤U¸ü (39.64 KB)

2015-10-24 17:12

¡@
´M¨DVBA¥ô¦ó¸Ñªk¡A
­Ó¤H¥u·|¡e¥|½ü©w¦ì¡fªk¡A¬°ÁקK¤j®a¦³¥ý¤J¬°¥Dªº¬Ýªk¡A¼È¤£´£¨Ñµ{¦¡½X¡F

§Æ±æ¸ô¹L¤j¤j¤£§[´£¨Ñ§ó¦h¤èªk¡A
¥ý¦¹Á¹L¡ã¡ã
¡@
¡×¡×¡×2015.10.27 ¸É¥R¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×
µ{¦¡½X½Ð¨£¢°¢³¡ã¢°¢µ¼Ó¡A
¥H«D±M·~¦Û¾ÇªÌ¦Ó¨¥¡A¥u·|¥Î³Ì°ò¥»ªºÀx¦s®æ§PÂ_¡A©Ò¥H¹ïªì¾ÇªÌ¤]À³®e©ö¬ÝÀ´¡A
¦Ó¨ä¥¦¤j¤jªºµ{¦¡½X¡A¹ê¬°¥¿³Wªº¸Ñªk¡A§ó¦³°Ñ¦Ò»ù­È¡A
¦A«×ÁÂÁ¦U¦ì°Ñ»Pªº¤j¤j­Ì¡ã¡ã

ªþ¥ó¤U¸ü¡G
20151027-01(±ÛÂà¯x°}).rar (13.38 KB)

¤U¸ü¦¸¼Æ: 7

2015-10-27 14:46

¡@

­ã´£³¡ªL

¦^´_ 17# n7822123


³oÃD¥Øªº¬O¬Ý¤£¦Pªº¸Ñªk, ¶°«ä¼s¸q!
¶Q¸Ñ´ú¸Õ§¹¥þ¥i¥Î, ÁÂÁ°ѻP!

n7822123

¦^´_ 1# ­ã´£³¡ªL

¤£ª¾¹D²{¦b¦^·|¤£·|¤Ó±ß~
§Ú¥Î«Üª½Ä±ªº¼gªk¡A¨«¨ì©³´NÂàÅs~

1. Sub ¤è°}1()
   
2. Dim ̊ƒ As Byte
   
3. Dim Ãä As Byte
   
4. Dim X0 As Byte
   
5. Dim Y0 As Byte
   
6. Dim n As Integer
   
7. Cells(5, 5).CurrentRegion = ""
   
8. ̊ƒ = (Cells(1, 2) - 1) / 2
   
9. X0 = ̊ƒ + 5: Y0 = ̊ƒ + 5
   
10. n = 1: X = X0: Y = Y0: Ãä = 1
    
11. Cells(Y, X) = n: n = n + 1
    
12. ¦V¥k:
    
13. If n = (̊ * 2 + 1) ^ 2 And ̊ < ̊ƒ Then ̊ = ̊ + 1
    
14. If n = (Ãä * 2 + 1) ^ 2 And Ãä = Ãä¬É Then GoTo µ²§À
    
15. If X + 1 - X0 > Ãä Then GoTo ¦V¤U
    
16. X = X + 1: Cells(Y, X) = n: n = n + 1: GoTo ¦V¥k
    
17. ¦V¤U:
    
18. If Y + 1 - Y0 > Ãä Then GoTo ¦V¥ª
    
19. Y = Y + 1: Cells(Y, X) = n: n = n + 1: GoTo ¦V¤U
    
20. ¦V¥ª:
    
21. If X - 1 - X0 < -Ãä Then GoTo ¦V¤W
    
22. X = X - 1: Cells(Y, X) = n: n = n + 1: GoTo ¦V¥ª
    
23. ¦V¤W:
    
24. If Y - 1 - Y0 < -Ãä Then GoTo ¦V¥k
    
25. Y = Y - 1: Cells(Y, X) = n: n = n + 1: GoTo ¦V¤W
    
26. µ²§À:
    
27. X = X + 1: Cells(Y, X) = n
    
28. End Sub
    
29. 
    
30. Sub ¤è°}2()
    
31. Dim ̊ƒ As Byte
    
32. Dim Ãä As Byte
    
33. Dim X0 As Byte
    
34. Dim Y0 As Byte
    
35. Dim n As Integer
    
36. Cells(5, 5).CurrentRegion = ""
    
37. ̊ƒ = (Cells(1, 2) - 1) / 2
    
38. X0 = ̊ƒ + 5: Y0 = ̊ƒ + 5
    
39. n = 1: X = X0: Y = Y0: Ãä = 1
    
40. Cells(Y, X) = "¡·": n = n + 1
    
41. ¦V¥k:
    
42. If n = (̊ * 2 + 1) ^ 2 And ̊ < ̊ƒ Then ̊ = ̊ + 1
    
43. If n = (Ãä * 2 + 1) ^ 2 And Ãä = Ãä¬É Then GoTo µ²§À
    
44. If X + 1 - X0 > Ãä Then GoTo ¦V¤U
    
45. X = X + 1
    
46. If X - X0 = Ãä Then Cells(Y, X) = "¢{" Else Cells(Y, X) = "¡÷"
    
47. n = n + 1: GoTo ¦V¥k
    
48. ¦V¤U:
    
49. If Y + 1 - Y0 > Ãä Then GoTo ¦V¥ª
    
50. Y = Y + 1
    
51. If Y - Y0 = Ãä Then Cells(Y, X) = "¢}" Else Cells(Y, X) = "¡õ"
    
52. n = n + 1: GoTo ¦V¤U
    
53. ¦V¥ª:
    
54. If X - 1 - X0 < -Ãä Then GoTo ¦V¤W
    
55. X = X - 1
    
56. If X - X0 = -Ãä Then Cells(Y, X) = "¢|" Else Cells(Y, X) = "¡ö"
    
57. n = n + 1: GoTo ¦V¥ª
    
58. ¦V¤W:
    
59. If Y - 1 - Y0 < -Ãä Then GoTo ¦V¥k
    
60. Y = Y - 1
    
61. If Y - Y0 = -Ãä Then Cells(Y, X) = "¢z" Else Cells(Y, X) = "¡ô"
    
62. n = n + 1: GoTo ¦V¤W
    
63. µ²§À:
    
64. X = X + 1: Cells(Y, X) = "¡´"
    
65. End Sub

½Æ»s¥N½X

­ã´£³¡ªL

¡Õ¤Q¦r«DªÅÀˬdªk¡Ö
Sub ¼Æ¦r¯x°}_¤Q¦r«DªÅÀˬdªk()
Dim i&, xR As Range, R&, C&, N, j&, k&
N = InputBox("¿é¤JÄæ¦C¼Æ", , 11)
Cells.ClearContents
Set xR = Cells(N / 2 + 2, N / 2 + 2): xR = 1: Set xR = xR(1, 2)
For i = 2 To N * N
¡@¡@For j = 1 To 4
¡@¡@¡@¡@If xR(0, 0).Resize(3, 3).Item(j * 2) <> "" Then k = k & j
¡@¡@Next j
¡@¡@If k < 5 Then R = Mid("1201", k, 1): C = Mid("0112", k, 1)
¡@¡@xR = i:  Set xR = xR(R, C): k = 0
¡@¡@Sleep 10
Next i
End Sub
¡@
'¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×
Sub ¤è¦V¯x°}_¤Q¦r«DªÅÀˬdªk()
Dim i&, xR As Range, R&, C&, N, j&, k&, T$
N = InputBox("¿é¤JÄæ¦C¼Æ", , 11)
Cells.ClearContents
Set xR = Cells(N / 2 + 2, N / 2 + 2): xR = "¡·": Set xR = xR(1, 2)
For i = 2 To N * N - 1
¡@¡@For j = 1 To 4
¡@¡@¡@¡@If xR(0, 0).Resize(3, 3).Item(j * 2) <> "" Then k = k & j
¡@¡@Next j
¡@¡@If k < 5 Then
¡@¡@¡@¡@R = Mid("1201", k, 1): C = Mid("0112", k, 1)
¡@¡@¡@¡@T = Mid("¡ö¡õ¡ô¡÷", k, 1): xR = Mid("¢}¢{¢|¢z", k, 1)
¡@¡@End If
¡@¡@If xR = "" Then xR = T
¡@¡@Set xR = xR(R, C): k = 0
¡@¡@Sleep 10
Next i
xR = "¡´"
End Sub

­ã´£³¡ªL

¡ÕÀ𨤺N¯Áªk¡Ö
Sub ¼Æ¦r¯x°}_À𨤺N¯Áªk()
Dim i&, xR As Range, R&, C&, N
N = InputBox("¿é¤JÄæ¦C¼Æ", , 11)
Cells.ClearContents
Set xR = Cells(N / 2 + 2, N / 2 + 2): xR = 1: Set xR = xR(1, 2)
For i = 2 To N * N
¡@¡@If xR(1, 0) <> "" And xR(2, 1) = "" Then R = 2: C = 1
¡@¡@If xR(0, 1) <> "" And xR(1, 0) = "" Then R = 1: C = 0
¡@¡@If xR(1, 2) <> "" And xR(0, 1) = "" Then R = 0: C = 1
¡@¡@If xR(2, 1) <> "" And xR(1, 2) = "" Then R = 1: C = 2
¡@¡@xR = i:  Set xR = xR(R, C)
¡@¡@Sleep 10
Next i
End Sub
¡@
'¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×
Sub ¤è¦V¯x°}_À𨤺N¯Áªk()
Dim i&, xR As Range, R&, C&, T$, N
N = InputBox("¿é¤JÄæ¦C¼Æ", , 11)
Cells.ClearContents
Set xR = Cells(N / 2 + 2, N / 2 + 2):  xR = "¡·":  Set xR = xR(1, 2)
For i = 2 To N * N - 1
    If xR(1, 0) <> "" And xR(2, 1) = "" And xR(0, 1) = "" Then R = 2: C = 1: xR = "¢{": T = "¡õ"
    If xR(0, 1) <> "" And xR(1, 0) = "" And xR(1, 2) = "" Then R = 1: C = 0: xR = "¢}": T = "¡ö"
    If xR(1, 2) <> "" And xR(0, 1) = "" And xR(2, 1) = "" Then R = 0: C = 1: xR = "¢|": T = "¡ô"
    If xR(2, 1) <> "" And xR(1, 2) = "" And xR(1, 0) = "" Then R = 1: C = 2: xR = "¢z": T = "¡÷"
    If xR = "" Then xR = T
    Set xR = xR(R, C)
    Sleep 10
Next i
xR = "¡´"
End Sub

­ã´£³¡ªL

¥u·|°ò¥»ªºRange§P©w¤èªk¡A¥H¤Uµ{¦¡½X¨Ñ°Ñ¦Ò¡A
¹ïªì¾ÇVBAªÌÀ³«Ü®e©ö¬Ý±oÀ´¡G
¡Õ¥|½ü©w¦ìªk¡Ö
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
¡@
Sub ¼Æ¦r¯x°}_¥|½ü©w¦ìªk()
Dim N, xR As Range, M(1 To 4) As Range, C%, R%, X%, Y%
N = InputBox("½Ð¿é¤J¤è°}Äæ¦C¼Æ", , 11)
Cells.ClearContents
Set xR = Cells(N / 2 + 2, N / 2 + 2): Set M(1) = xR(2)
For i = 2 To 4: Set M(i) = xR: Next
R = 1: C = 2
For j = 1 To N * N
¡@¡@xR = j: Set xR = xR(R, C): X = xR.Row: Y = xR.Column
¡@¡@If X < M(1).Row And Y > M(1).Column Then R = 2: C = 1: Set M(1) = xR
¡@¡@If X > M(2).Row And Y > M(2).Column Then R = 1: C = 0: Set M(2) = xR
¡@¡@If X > M(3).Row And Y < M(3).Column Then R = 0: C = 1: Set M(3) = xR
¡@¡@If X < M(4).Row And Y < M(4).Column Then R = 1: C = 2: Set M(4) = xR
¡@¡@Sleep 10
101: Next
End Sub

'¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×
Sub ¤è¦V¯x°}_¥|½ü©w¦ìªk()
Dim N, xR As Range, M(1 To 4) As Range, C%, R%, X%, Y%, T$
N = InputBox("½Ð¿é¤J¤è°}Äæ¦C¼Æ", , 11)
Cells.ClearContents
Set xR = Cells(N / 2 + 2, N / 2 + 2): Set M(1) = xR(2)
For i = 2 To 4: Set M(i) = xR: Next
R = 1: C = 2: T = "¡·"
For j = 1 To N * N - 1
¡@¡@If xR = "" Then xR = T
¡@¡@Set xR = xR(R, C): X = xR.Row: Y = xR.Column
¡@¡@If X < M(1).Row And Y > M(1).Column Then R = 2: C = 1: T = "¡õ": Set M(1) = xR: xR = "¢{"
¡@¡@If X > M(2).Row And Y > M(2).Column Then R = 1: C = 0: T = "¡ö": Set M(2) = xR: xR = "¢}"
¡@¡@If X > M(3).Row And Y < M(3).Column Then R = 0: C = 1: T = "¡ô": Set M(3) = xR: xR = "¢|"
¡@¡@If X < M(4).Row And Y < M(4).Column Then R = 1: C = 2: T = "¡÷": Set M(4) = xR: xR = "¢z"
¡@¡@Sleep 10
101: Next
xR = "¡´"
End Sub

­ã´£³¡ªL

¦^´_ 9# bobomi

ÁÂÁ´£¨Ñºë¤ß¤§§@,
¤]ÁÂÁ¯S¨Ó°Ñ»P, ·P®¦~~

no3-taco

¦^´_ 8# ­ã´£³¡ªL

¨S¦³¼g±o«Ü¦n¡A¤@¶}©l´N¥u¦Ò¼{¨ì¹ïºÙ©Ê
¦ý¬OÁÙ¬O¦³²Å¦XÃD¥Ø»Ý¨D¡A¶K¤W¨ÓÅý¤j®a«ü¾É¶¶«K­×¥¿­þ¸ÌÁÙ¦³°ÝÃD

1. Sub testarrX2()  '³o¸Ì°õ¦æ
   
2. Cells.Clear
   
3. Dim n&: n = 15        '¥u¯à©_¼Æ
   
4. Cells(11, 8).Select    '=>¨¬°÷¶ñ¥Rªº¦ì¸m
   
5. arrX2 n, n, 0         '©_¼Æ¤è°} ,©T©w­È ,(0=>²Å¸¹ªí¦¡,¤j©ó0¼Æ¦r=>§Ç¦Cªí¥Ü)
   
6. End Sub
   
7. 
   
8. Sub arrX2(numX&, n&, k&)
   
9. Dim cx&, cy&, arr, arr2, arr3
   
10. arr = Array(0, 1, 0, -1, 0, 1)
    
11. arr2 = Array("¢{", "¢}", "¢|", "¢z", "¡´")
    
12. arr3 = Array("", "¡õ", "¡ö", "¡ô", "¡÷")
    
13. 
    
14. If numX <> 1 Then
    
15.     arrX2 numX - 2, n, k
    
16.     p = (numX - 1) / 2  '(¼W¶q)¦ì²¾¶q
    
17.     For i = 1 To 4
    
18.         For j = 0 To numX - 2   
    
19.             cx = ActiveCell.Column + p * arr(i) + arr(i + 1) * (j - p + 1)
    
20.             cy = ActiveCell.Row + p * arr(i - 1) + arr(i) * (j - p + 1)
    
21.             If k = 0 Then
    
22.                 If i = 1 And j = 0 Then
    
23.                     Cells(cy, cx) = arr2(0)
    
24.                 ElseIf i < 4 And j = numX - 2 Then
    
25.                     Cells(cy, cx) = arr2(i)
    
26.                 ElseIf j = numX - 2 And numX = n Then
    
27.                     Cells(cy, cx) = arr2(i)
    
28.                 Else
    
29.                     Cells(cy, cx) = arr3(i)
    
30.                 End If
    
31.             Else
    
32.                 k = k + 1
    
33.                 Cells(cy, cx) = k
    
34.             End If
    
35.         Next j
    
36.     Next i
    
37. Else
    
38.     ActiveCell = IIf(k > 0, k, "¡·")
    
39. End If
    
40. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 1# ­ã´£³¡ªL
Sub ¥H±ÛÂà¤è¦¡¶ñ¤J­È() §½­­¦b[A1:Z26]

1. Sub testarr()
   
2. arrX 7, 1  '2003 '¶¥¼Æ¶·¬O©_¼Æ,¦p°¸¼Æ°õ¦æ¦³°ïÅ|ªÅ¶¡¤£¨¬ªº¿ù»~
   
3. End Sub

½Æ»s¥N½X

Sub Ex()
    '¯x°}¥i¬°5*5,6*6,7*7,..256*256...µøExcelª©¥»
    Dim xNo As Double, Rng As Range, Rc As Double, i As Integer
    ActiveSheet.UsedRange.Clear
    xNo = Application.InputBox("¿é¤J±Æ¦C¼Æ¦r", , 25, Type:=1)
    Rc = Application.Evaluate("CEILING(Sqrt(" & xNo & "),1)")
    If Rc Mod 2 <> 0 Then i = 1
    If Int(Rc / 2) + i > Int(Columns.Count / 2) Then
       MsgBox "¿é¤J±Æ¦C¼Æ¦r" & xNo & "ªºÄæ¦ì¼Æ " & Int(Rc / 2) + i & vbLf & "¤j©ó ¤u§@ªí¤§Á`Äæ¦ì/ 2  =>" & Columns.Count / 2
       End
    End If
    Set Rng = Cells(Int(Rc / 2) + i, Int(Rc / 2) + i)   '¥HA1¬°¬Û¹ï¦ì¸mªº¤¤¤ßÀx¦s®æ
    Rng.Select
    Rng.Interior.Color = vbRed
    Rng = 1
    Do
        '¥k,¤U,¥ª,¤W ¶¶®ÉÄÁ¤è¦V
        Do
            If Rng >= Rc * Rc Then End
            Rng.Offset(, 1) = Rng + 1
            Set Rng = Rng.Offset(, 1)   '¥k²¾¤@Äæ
        Loop Until Rng.Offset(1) = ""   '¤U¤@¦C = ""
        
        Do
            Rng.Offset(1) = Rng + 1
            Set Rng = Rng.Offset(1)      '¤U²¾¤@¦C
        Loop Until Rng.Offset(, -1) = "" '¥ª¤@Äæ = ""
   
        Do
            If Rng >= Rc * Rc Then End
            Rng.Offset(, -1) = Rng + 1
            Set Rng = Rng.Offset(, -1)  '¥ª²¾¤@Äæ
        Loop Until Rng.Offset(-1) = ""  '¤W¤@¦C = ""
   
        Do
            Rng.Offset(-1) = Rng + 1
            Set Rng = Rng.Offset(-1)    '¤W²¾¤@¦C
        Loop Until Rng.Offset(, 1) = "" '¥k¤@Äæ = ""
    Loop
   
End Sub

ML089

¦^´_ 9# bobomi

¥[¤J bobomi ªº
¥k = [{0, 1, "¡÷","¢z"}]: ¤U = [{1,0,"¡õ","¢{"}]: ¥ª = [{0,-1,"¡ö","¢}"}]: ¤W = [{-1, 0,"¡ô","¢|"}]
®ÄªG¹Ï¤G´N¥X¨Ó¤F

Option Base 1
Sub ¥H±ÛÂà¤è¦¡¶ñ¤J­È()

    xc = 10: yc = 10    '¤¤¤ß¦ì¸m

    ¥k = [{0, 1, "¡÷","¢z"}]: ¤U = [{1,0,"¡õ","¢{"}]: ¥ª = [{0,-1,"¡ö","¢}"}]: ¤W = [{-1, 0,"¡ô","¢|"}]
    yx = Array(¥k, ¤U, ¥ª, ¤W)    '±±¨î¤è¦V¤Î¶¶®ÉÂà¦V

    '    ¥k = [{0, 1, "¡÷","¢|"}]: ¤U = [{1,0,"¡õ","¢z"}]: ¥ª = [{0,-1,"¡ö","¢{"}]: ¤W = [{-1, 0,"¡ô","¢}"}]
    '    yx = Array(¤U, ¥k, ¤W, ¥ª)    '±±¨î¤è¦V¤Î°f®ÉÂà¦V

    n = InputBox("¿é¤J±Æ¦C¼Æ¦r", , 25)
    [A1:Z26].ClearContents

    x = xc: y = yc: xp1 = x: yp1 = y
    Cells(x, y) = 1
    f1 = "": f2 = ""
    For i = 2 To n
        ds = [{"","","",""}]
        For j = 1 To 4    '¥|­Ó¤è¦V
            yy = yx(j)(1): xx = yx(j)(2)
            If Cells(y + yy, x + xx) = "" Then
                ds(j) = ((y + yy - yc) ^ 2 + (x + xx - xc) ^ 2) * 10 + j    '¶ZÂ÷*10+¤è¦V
            End If
        Next
        k = Application.Min(ds) Mod 10    '¨ú¶ZÂ÷­ìÂI³Ìµu¤Î±Æ¦C³Ì«e¤è¦V

        y = y + yx(k)(1)
        x = x + yx(k)(2)
        Cells(y, x) = i

        ¤è¦V²Å¸¹ = IIf(i = 2, "¡·", yx(k)(3 + IIf(k = kp1, 0, 1)))
        Cells(yp1, xp1) = Cells(yp1, xp1) & ¤è¦V²Å¸¹
        yp1 = y: xp1 = x: kp1 = k

        'Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1)
    Next
    Cells(yp1, xp1) = Cells(yp1, xp1) & "¡´"
End Sub