在方陣或矩陣中,以旋轉方式填入值 - Excel程式區

帖子: 181
主題: 5
精華: 0
積分: 197
點名: 0
作業系統: XP
軟體版本: 2000
閱讀權限: 20
性別: 女
註冊時間: 2014-3-9
最後登錄: 2024-4-29

9^# 跳轉到 »

發表於 2015-10-25 22:20 | 只看該作者

本帖最後由 bobomi 於 2015-10-25 22:27 編輯

Sub q77()

  Cells.Clear

'**** 上、下、左、右  copy from  ML089 ****
  右 = [{0, 1, "→","┌"}]: 下 = [{1,0,"↓","┐"}]: 左 = [{0,-1,"←","┘"}]: 上 = [{-1, 0,"↑","└"}]

  yx = Array(右, 下, 左, 上)

  r = 10
  c = 10
  Value = 1
  Cells(r, c) = Value
  For Count = 1 To  6^2
  rc = yx(方向 Mod 4)
  n = CLng(Count / 2 + 0.001)
  For Repeat = 1 To n
   r = r + rc(1)
   c = c + rc(2)
   Value = Value + 1
   If Repeat = n Then
      Cells(r, c) = yx((方向 + 1) Mod 4)(4) & " " & Value
   Else
      Cells(r, c) = rc(3) & " " & Value
   End If
  Next
  方向 = 方向 + 1
  Next

' 最後 ◎ ● 這2符號請自己處理

End Sub

2 評分人數

准提部林: 精品文章，也是值得參考好式金錢 + 5
ML089: 精品文章，第一個達陣的。金錢 + 5

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-26

8^#

發表於 2015-10-25 20:41 | 只看該作者

回復 7# no3-taco

～～只是剛剛練習寫〔正好〕有寫出來～～　

那就更不簡單，我是腦神經快轉不過來了！
這題本以為不會有人關注，沒想到還是得到兩個不同解法，真是感激您們的關注！
繼續期待其它解法！！

需求結果２也可再想想～～

TOP

no3-taco

中學生 Rank: 2

帖子: 41
主題: 0
精華: 0
積分: 79
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-4-1
最後登錄: 2016-2-17

7^#

發表於 2015-10-25 20:26 | 只看該作者

回復 6# 准提部林

p = p + 1 '修改時忘記拿掉

我不是老手，只是剛剛練習寫正好有寫出來

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-26

6^#

發表於 2015-10-25 20:11 | 只看該作者

回復 5# no3-taco

這是我完全不可能去想的方式, 真是老手 + 高手,
測試完全符合,
謝謝您的參與及提供知識結晶~~

TOP

no3-taco

中學生 Rank: 2

帖子: 41
主題: 0
精華: 0
積分: 79
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-4-1
最後登錄: 2016-2-17

5^#

發表於 2015-10-25 19:25 | 只看該作者

本帖最後由 no3-taco 於 2015-10-25 19:34 編輯

沒有寫得很精實，但是結果是一樣的
ps:需先點選一個足夠填滿的儲存格

Sub testarr() '從這裡執行
arrX 7, 1 '7階 ,數列初始值
End Sub
Sub arrX(numX&, k&)
Dim cx&, cy&
arr = Array(0, 1, 0, -1, 0, 1)
If numX <> 1 Then
arrX numX - 2, k
p = (numX - 1) / 2
For i = 1 To 4
For j = 0 To numX - 2
k = k + 1
cx = ActiveCell.Row + p * arr(i - 1) + arr(i) * j - arr(i) * (p - 1)
cy = ActiveCell.Column + p * arr(i) + arr(i + 1) * j - arr(i + 1) * (p - 1)
Cells(cx, cy) = k
Next j
Next i
p = p + 1
Else
ActiveCell = k
End If
End Sub

複製代碼

2 評分人數

ML089: 精品文章，速度真快金錢 + 5
准提部林: 精品文章金錢 + 5

TOP

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

4^#

發表於 2015-10-25 09:06 | 只看該作者

回復 3# 准提部林

知識+的W大用數學及函數的功力真是無人能敵，原先一開始我也是朝這方向構想。

後來看你貼的效果圖在哪裡轉啊轉啊，突然想到既然要用VBA就有全新的構想。
從貼圖的運動模式可以整理如下
1. 每一步只有上、下、左、右等4種步法
2. 要圍繞中心排列，所以每一步都要選擇離中心最近的距離。

'控制方向及轉向
yx = Application.Transpose(Application.Transpose(Array(右, 下, 左, 上))) '第一步向右，順時排列
圖片 1.jpg

利用上式中 ... 右, 下, 左, 上的放置順序來控制方向及轉向
第1位置控制第一步方向，可以放置 ..... 右, 下, 左, 上 .... 來改變。
第2~3位置控制順、逆排列方向。

yx = Application.Transpose(Application.Transpose(Array(下, 右, 上, 左))) '第一步向下，逆時排列
圖片 2.jpg