這好像是古早 Basic 的題目.. :D||
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
這行是啥
沒看過這種寫法

呃...更理想的寫法我想不出來（功力未到家）:D
不過任意指定最大值的我已改成了，這樣如何：

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
請指教 :)

最初由 VicLin 發表
[A1:A5].ClearContents
這行是啥
沒看過這種寫法
是一種簡寫，
等於 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

jute弟，謝謝你讓我想起還有 IIF 這東東 :D

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

另外，請原諒題目說的不夠清楚..
其實也有一部份是後來才發現 --
請把 A 欄的字型分別設為固定寬度和非固定寬度(如細明体和新細明体)，
看看結果有何不同 :D
如果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分貼文，佩服佩服! :D

雖然是投機取巧，但若是用在 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
不過若不是 Excel，如何只用一個 for loop 達到目的就不曉得了:D

既然是用Excel，這樣當然可以囉。
果然工作表函數還是很重要的，
"變通"也是很重要的~ ^^

工作表的特性之一就是隨你填哪一格，
而不是只能一行一行照順序來..
這個例子充分運用了Excel的特性~
果然，N人行必有我師焉! :D:D

哇, genius!
請受小弟一拜~~~