標題:
請問如何用VBA.自動合併儲存格"跨列置中"
[打印本頁]
作者:
joey3277
時間:
2013-6-25 18:18
標題:
請問如何用VBA.自動合併儲存格"跨列置中"
爬文過一般區 看到類似的問題好像函數無法解決
所以到程式區來請求幫忙
[attach]15317[/attach]
如圖
有什麼辦法 可以讓圖片左邊A欄跟B欄 跨列置中 跟圖片右邊G欄跟H欄一樣
有使用錄製巨集的方法 但因為每張工作表要跨列置中的空隔數不同 資料的多寡也不同
所以用錄製的方法也不行
懇請各問大大幫忙
[attach]15318[/attach]
作者:
kimbal
時間:
2013-6-25 22:34
Sub test()
Dim lngRowCount As Long
Dim lngRowCounter As Long
Dim lngRowCountLast As Long
lngRowCount = Range("C1").End(xlDown).Row
If lngRowCount = 2 Then Exit Sub
lngRowCountLast = 1
For lngRowCounter = 2 To lngRowCount - 1
With Range("A1")
If lngRowCounter = lngRowCount - 1 And Not (lngRowCountLast = lngRowCounter - 1) Then
Range(.Offset(lngRowCountLast), .Offset(lngRowCounter)).Merge
Range(.Offset(lngRowCountLast, 1), .Offset(lngRowCounter, 1)).Merge
End If
If .Offset(lngRowCounter) <> "" Then
If Not (lngRowCountLast = lngRowCounter - 1) Then
Range(.Offset(lngRowCountLast), .Offset(lngRowCounter - 1)).Merge
Range(.Offset(lngRowCountLast, 1), .Offset(lngRowCounter - 1, 1)).Merge
End If
lngRowCountLast = lngRowCounter
End If
End With
Next
End Sub
複製代碼
作者:
joey3277
時間:
2013-6-26 22:05
謝謝大大熱心的提供VBA
作者:
joey3277
時間:
2013-7-4 19:25
再請問一下
1.可否修改程式為"選取的儲存格範圍".或著選取的欄別
2.或著合併儲存格只有固定一欄時
應該修改哪各地方
謝謝
作者:
GBKEE
時間:
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
複製代碼
作者:
joey3277
時間:
2013-7-6 12:39
謝謝大大的幫忙！！趕緊試試
作者:
joey3277
時間:
2013-7-7 13:01
請教一下kimbal 大大
使用你提供的程式碼遇到了一各問題
如果最後一個要合併的儲存格要合併的格數是兩格的話
程式碼就會抓不到最後一各
如提供的表上最後一格要合併的是15.16.17列這沒有問題
但如果只要合併15.16列 程式就只會執行到13列
PS.可另請教如果要合併的只有B欄
那你提供的程式碼要改哪邊呢?
作者:
joey3277
時間:
2013-7-7 13:04
謝謝GBKEE 大大提供的程式碼
測試過了 超級方便好用
謝謝幫忙
作者:
GBKEE
時間:
2013-7-7 15:03
回復
7#
joey3277
修改如下
Option Explicit
Sub test()
Dim lngRowCount As Long, Rng As Range, R As Range
Dim lngRowCounter As Long
Dim lngRowCountLast As Long
On Error Resume Next '不理會程序上的錯誤,繼續執行程式
Set Rng = Application.InputBox("選取儲存格(可選多重範圍)", Type:=8) '如沒有選取儲存格:程序上的錯誤
If Err <> 0 Then Exit Sub '程序上有錯誤
For Each R In Rng.Areas
lngRowCount = R.Rows.Count '範圍的總列數
lngRowCountLast = 1
For lngRowCounter = 2 To lngRowCount
With R.Range("A1")
If .Offset(lngRowCounter) <> "" Or lngRowCounter = lngRowCount Then
If Not (lngRowCountLast = lngRowCounter - 1) Then
.Parent.Range(.Offset(lngRowCountLast), .Offset(lngRowCounter - 1)).Merge
End If
lngRowCountLast = lngRowCounter
End If
End With
Next
Next
End Sub
複製代碼
作者:
joey3277
時間:
2013-7-8 11:39
GBKEE 大大
你幫忙修改的程式碼 出現2各狀況
1.所選取的範圍第一各合併的儲存格的第一列都無法合併.如:1.2列要合併(無作用)如:1.2.3列要合併(2.3列會合併.但不會跟1列合併)如:1.2.3.4列要合併(2.3.4會合併.但1列還是無法一起合併)
是每次要選取合併範圍第一各合併都會有這種現象
2.如果是點選整欄就會最後一各合併儲存格無限大的往下延伸
PS原來kimbal 大大提供的程式碼產生的那各問題.在你修正的程式碼裡已解決
真不好意思 一直找麻煩:(
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
