請問如何用VBA.自動合併儲存格"跨列置中"

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2013-7-7 15:03 | 顯示全部帖子

回復 7# joey3277
修改如下

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 盡多少本份，就得多少本事。