Take it easy~ | 【討論】用 VBA 畫一個菱形排列 這好像是古早 Basic 的題目.. || Sub aa() [A1:A5].ClearContents For i = 1 To 5 v_star = "" If i > 3 Then c = c - 1 Else c = c + 1 For j = 1 To c v_star = v_star & "* " Next j v_star = Space(c + 3 - c * 2) & v_star Cells(i, 1) = v_star Next i End Sub 效果如下 (因這裡會消掉前置空格,只好以底線代替) __* _* * * * * _* * __* 有誰可以提供更簡潔或更理想的寫法嗎? 還有,這裡最大數 3,能否改成可任意指定的? 討論一下嘛。 |
回覆 |
會員 | [A1:A5].ClearContents 這行是啥 沒看過這種寫法 |
回覆 |
圈外人 | 呃...更理想的寫法我想不出來(功力未到家) 不過任意指定最大值的我已改成了,這樣如何: 語法: Sub aa() mx = InputBox("輸入最大值:") If mx = "" Or Not IsNumeric(mx) Then Exit Sub [A1].EntireColumn.ClearContents For i = 1 To mx * 2 - 1 v_star = "" c = IIf(i > Val(mx), c - 1, c + 1) For j = 1 To c v_star = v_star & "* " Next j v_star = Space(c + mx - c * 2) & v_star Cells(i, 1) = v_star Next i End Sub |
回覆 |
Take it easy~ | 引用:
等於 Range("A1:A5").ClearContents 。 Range("A1") 可以寫成 [A1] ; 定義名稱"ABC",Range("ABC") 可以寫成 [ABC] , 以此類推。 | |
回覆 |
嘴炮戰隊隊長 | 可修改tCnt大小來變更菱形大小。 語法: Sub DrawArr() Dim tCnt As Long Dim tIdx As Long tCnt = 20 [A1:A65535].ClearContents For tIdx = 1 To tCnt Cells(tIdx, 1) = String(tCnt - tIdx, " ") & String(tIdx, "*") Cells(tCnt + tIdx - 1, 1) = String(tIdx - 1, " ") & String(tCnt - tIdx + 1, "*") Next tIdx End Sub |
回覆 |
Take it easy~ | jute弟,謝謝你讓我想起還有 IIF 這東東 Ivan弟,這只用一個loop的手法真是高招,愚兄暫時還不能參透~ ^^|| 但題目是要求每兩個star中間有一個空白, 我承認沒有說的很清楚.. 但因此String函數就派不上用場了是吧? anyway,先把這犀利的程式稍改一下,你看如何: 語法: Sub aaa1() [A:A].ClearContents x = Application.InputBox("Enter Number ", Type:=1) For i = 1 To x Cells(i, 1) = Space(x - i) & String(i, "*") Cells(x + i - 1, 1) = Space(i - 1) & String(x - i + 1, "*") Next i End Sub |
回覆 |
Take it easy~ | 另外,請原諒題目說的不夠清楚.. 其實也有一部份是後來才發現 -- 請把 A 欄的字型分別設為固定寬度和非固定寬度(如細明体和新細明体), 看看結果有何不同 如果star之間沒有空白,那套用兩種字型的結果會差很多.. 在別的地方得到的啟發:ABS函數真好用。^^ 因此我想要的正解是像這樣 語法: Sub aaa2() [A:A].ClearContents x = Application.InputBox("Enter Number ", Type:=1) For i = 1 To x * 2 - 1 v_star = Space(Abs(x - i)) For j = Abs(x - i) To x - 1 v_star = v_star & "* " Next Cells(i, 1) = v_star Next i [A:A].EntireColumn.AutoFit End Sub 的前提下最簡潔的答案了吧.. 當然,如果不要空格,那非Ivan的答案莫屬啦~ 對了,忘了補充: Ivan你竟在10月10日10時10分貼文,佩服佩服! |
回覆 |
圈外人 | 雖然是投機取巧,但若是用在 Excel 上,套用 formula 也是可以吧: 語法: Sub DrawArr() Dim tCnt As Long Dim tIdx As Long tCnt = InputBox("Enter value:") [A:A].ClearContents For tIdx = 1 To tCnt Cells(tIdx, 1).Formula = "=rept(char(32)," & tCnt - tIdx & _ ") & rept(char(42) & char(32)," & tIdx & ")" Cells(tCnt + tIdx - 1, 1).Formula = "=rept(char(32)," & tIdx - 1 & _ ") & rept(char(42) & char(32)," & tCnt - tIdx + 1 & ")" Next tIdx End Sub |
回覆 |
Take it easy~ | 既然是用Excel,這樣當然可以囉。 果然工作表函數還是很重要的, "變通"也是很重要的~ ^^ 工作表的特性之一就是隨你填哪一格, 而不是只能一行一行照順序來.. 這個例子充分運用了Excel的特性~ 果然,N人行必有我師焉! |
回覆 |
Take it easy~ | 哇, genius! 請受小弟一拜~~~ |
回覆 |
|
類似的主題 | ||||
主題 | 主題作者 | 討論版 | 回覆 | 最後發表 |
在EXCEL中如何判斷顏色取值?(VBA) | TPBUNNY | -- OFFICE 相 關 軟 體 討 論 版 | 7 | 2003-08-12 07:16 PM |
[VBA]月曆控制項亂碼問題 | leonchou | -- OFFICE 相 關 軟 體 討 論 版 | 1 | 2003-04-27 03:50 PM |
[VBA] 比對資料及設定格式 | leonchou | -- OFFICE 相 關 軟 體 討 論 版 | 1 | 2001-09-09 12:02 AM |
[VBA] 巨集簡介 | leonchou | -- OFFICE 相 關 軟 體 討 論 版 | 0 | 2001-08-26 05:40 PM |
[VBA] 自動巨集與活頁薄事件 | leonchou | -- OFFICE 相 關 軟 體 討 論 版 | 1 | 2001-08-22 08:32 PM |
XML | RSS 2.0 | RSS |
本論壇所有文章僅代表留言者個人意見,並不代表本站之立場,討論區以「即時留言」方式運作,故無法完全監察所有即時留言,若您發現文章可能有異議,請 email :[email protected] 處理。