- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# 准提部林
Sub 以旋轉方式填入值() 局限在[A1:Z26]- Sub testarr()
- arrX 7, 1 '2003 '階數須是奇數,如偶數執行有堆疊空間不足的錯誤
- End Sub
'矩陣可為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("輸入排列數字", , 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 "輸入排列數字" & xNo & "的欄位數 " & Int(Rc / 2) + i & vbLf & "大於 工作表之總欄位/ 2 =>" & Columns.Count / 2
End
End If
Set Rng = Cells(Int(Rc / 2) + i, Int(Rc / 2) + i) '以A1為相對位置的中心儲存格
Rng.Select
Rng.Interior.Color = vbRed
Rng = 1
Do
'右,下,左,上 順時鐘方向
Do
If Rng >= Rc * Rc Then End
Rng.Offset(, 1) = Rng + 1
Set Rng = Rng.Offset(, 1) '右移一欄
Loop Until Rng.Offset(1) = "" '下一列 = ""
Do
Rng.Offset(1) = Rng + 1
Set Rng = Rng.Offset(1) '下移一列
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) = "" '上一列 = ""
Do
Rng.Offset(-1) = Rng + 1
Set Rng = Rng.Offset(-1) '上移一列
Loop Until Rng.Offset(, 1) = "" '右一欄 = ""
Loop
End Sub |
-
1
評分人數
-
|
發表於 2015-10-26 16:03
| 