- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
5#
發表於 2013-7-5 09:11
| 只看該作者
回復 4# joey3277
試試看- Option Explicit
- Sub Ex()
- Dim Rng(1 To 3) As Range, A As Range, C As Range, R As Integer
- On Error Resume Next '不理會程序上的錯誤,繼續執行程式
- Set Rng(1) = Application.InputBox("選取儲存格(可選多重範圍)", Type:=8) '如沒有選取儲存格:程序上的錯誤
- If Err <> 0 Then Exit Sub '程序上有錯誤
- On Error GoTo 0 '不處裡程序上的錯誤
- For Each A In Rng(1).Areas '物件集合: Areas (多重範圍)
- For Each C In A.Columns '物件集合: Columns(欗位)
- Set Rng(2) = C.Cells(1) '物件:範圍的,第1個,儲存格開始
- R = C.Cells(C.Cells.Count).Row '數值 :物件範圍最後的儲存格列號
- Do
- Set Rng(3) = Rng(2).Offset(1) '物件 Rng(3): Rng(2)的下一列儲存格
- Do While Rng(3) = "" And Rng(3).Row <= R 'While(條件成立,執行迴圈):(物件="" 且須 物件<>物件範圍的最後列號)
- Set Rng(3) = Rng(3).Offset(1) '物件 Rng(3): Rng(3)的下一列儲存格
- Loop
- Rng(1).Parent.Range(Rng(2), Rng(3).Offset(-1)).Merge 'Merge(合併儲存格)
- Set Rng(2) = Rng(3) '物件 Rng(2): 有資料數值的儲存格
- Loop Until Rng(3).Row > R 'Until(條件不成立,執行迴圈)
- Next
- Next
- End Sub
|
|
發表於 2013-6-25 18:18
| 
發表於 2013-6-25 22:34
| 