返回列表 上一主題 發帖

[發問] 在方陣或矩陣中,以旋轉方式填入值

no3-taco

帖子
41 
主題
0 
精華
0 
積分
79 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-4-1 
最後登錄
2016-2-17 
1# 跳轉到 »
發表於 2015-10-25 19:25 | 顯示全部帖子
本帖最後由 no3-taco 於 2015-10-25 19:34 編輯

沒有寫得很精實，但是結果是一樣的
ps:需先點選一個足夠填滿的儲存格
  1. Sub testarr()  '從這裡執行
  2. arrX 7, 1  '7階 ,數列初始值
  3. End Sub

  5. Sub arrX(numX&, k&)
  6. Dim cx&, cy&
  7. arr = Array(0, 1, 0, -1, 0, 1)
  8. If numX <> 1 Then
  9. arrX numX - 2, k
  10.     p = (numX - 1) / 2
  11.     For i = 1 To 4
  12.         For j = 0 To numX - 2
  13.             k = k + 1
  14.             cx = ActiveCell.Row + p * arr(i - 1) + arr(i) * j - arr(i) * (p - 1)
  15.             cy = ActiveCell.Column + p * arr(i) + arr(i + 1) * j - arr(i + 1) * (p - 1)
  16.             Cells(cx, cy) = k
  17.         Next j
  18.     Next i
  19.     p = p + 1
  20. Else
  21.     ActiveCell = k
  22. End If
  23. End Sub
複製代碼
2

評分人數

TOP

no3-taco

帖子
41 
主題
0 
精華
0 
積分
79 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-4-1 
最後登錄
2016-2-17 
2#
發表於 2015-10-25 20:26 | 顯示全部帖子
回復 6# 准提部林

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

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

TOP

no3-taco

帖子
41 
主題
0 
精華
0 
積分
79 
點名
0  
作業系統
win7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2014-4-1 
最後登錄
2016-2-17 
3#
發表於 2015-10-26 17:02 | 顯示全部帖子
回復 8# 准提部林

沒有寫得很好，一開始就只考慮到對稱性
但是還是有符合題目需求，貼上來讓大家指導順便修正哪裡還有問題
  1. Sub testarrX2()  '這裡執行
  2. Cells.Clear
  3. Dim n&: n = 15        '只能奇數
  4. Cells(11, 8).Select    '=>足夠填充的位置
  5. arrX2 n, n, 0         '奇數方陣 ,固定值 ,(0=>符號表式,大於0數字=>序列表示)
  6. End Sub

  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("┐", "┘", "└", "┌", "●")
  12. arr3 = Array("", "↓", "←", "↑", "→")

  14. If numX <> 1 Then
  15.     arrX2 numX - 2, n, k
  16.     p = (numX - 1) / 2  '(增量)位移量
  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
複製代碼
1

評分人數

TOP

        靜思自在 : 真正的愛心，是照顧好自己的這顆心。
返回列表 上一主題