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

joey3277

爬文過一般區  看到類似的問題好像函數無法解決
所以到程式區來請求幫忙

下載 (63.15 KB)

2013-6-25 18:09

如圖
有什麼辦法  可以讓圖片左邊A欄跟B欄  跨列置中  跟圖片右邊G欄跟H欄一樣
有使用錄製巨集的方法  但因為每張工作表要跨列置中的空隔數不同   資料的多寡也不同
所以用錄製的方法也不行

懇請各問大大幫忙
跨列置中.rar (2.22 KB)

下載次數: 14

2013-6-25 18:17

kimbal

1. Sub test()
   
2.     Dim lngRowCount As Long
   
3.     Dim lngRowCounter As Long
   
4.     Dim lngRowCountLast As Long
   
5.    
   
6.     lngRowCount = Range("C1").End(xlDown).Row
   
7.    
   
8.     If lngRowCount = 2 Then Exit Sub
   
9.     lngRowCountLast = 1
   
10.    
    
11.    
    
12.     For lngRowCounter = 2 To lngRowCount - 1
    
13.         With Range("A1")
    
14.             If lngRowCounter = lngRowCount - 1 And Not (lngRowCountLast = lngRowCounter - 1) Then
    
15.                 Range(.Offset(lngRowCountLast), .Offset(lngRowCounter)).Merge
    
16.                 Range(.Offset(lngRowCountLast, 1), .Offset(lngRowCounter, 1)).Merge
    
17.             End If
    
18.             If .Offset(lngRowCounter) <> "" Then
    
19.                 If Not (lngRowCountLast = lngRowCounter - 1) Then
    
20.                     Range(.Offset(lngRowCountLast), .Offset(lngRowCounter - 1)).Merge
    
21.                     Range(.Offset(lngRowCountLast, 1), .Offset(lngRowCounter - 1, 1)).Merge
    
22.                 End If
    
23.                 lngRowCountLast = lngRowCounter
    
24.             End If
    
25.         End With
    
26.     Next
    
27. End Sub

複製代碼

joey3277

謝謝大大熱心的提供VBA

joey3277

再請問一下
1.可否修改程式為"選取的儲存格範圍".或著選取的欄別
2.或著合併儲存格只有固定一欄時  

應該修改哪各地方

謝謝

GBKEE

回復 4# joey3277
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng(1 To 3) As Range, A As Range, C As Range, R As Integer
   
4.     On Error Resume Next                                                   '不理會程序上的錯誤,繼續執行程式
   
5.     Set Rng(1) = Application.InputBox("選取儲存格(可選多重範圍)", Type:=8) '如沒有選取儲存格:程序上的錯誤
   
6.     If Err <> 0 Then Exit Sub                                               '程序上有錯誤
   
7.     On Error GoTo 0                                                         '不處裡程序上的錯誤
   
8.     For Each A In Rng(1).Areas                                              '物件集合: Areas  (多重範圍)
   
9.         For Each C In A.Columns                                             '物件集合: Columns(欗位)
   
10.             Set Rng(2) = C.Cells(1)                                         '物件:範圍的,第1個,儲存格開始
    
11.             R = C.Cells(C.Cells.Count).Row                                  '數值 :物件範圍最後的儲存格列號
    
12.             Do
    
13.                 Set Rng(3) = Rng(2).Offset(1)                               '物件 Rng(3): Rng(2)的下一列儲存格
    
14.                 Do While Rng(3) = "" And Rng(3).Row <= R                    'While(條件成立,執行迴圈):(物件="" 且須 物件<>物件範圍的最後列號)
    
15.                     Set Rng(3) = Rng(3).Offset(1)                           '物件 Rng(3): Rng(3)的下一列儲存格
    
16.                 Loop
    
17.                 Rng(1).Parent.Range(Rng(2), Rng(3).Offset(-1)).Merge        'Merge(合併儲存格)
    
18.                 Set Rng(2) = Rng(3)                                         '物件 Rng(2): 有資料數值的儲存格
    
19.             Loop Until Rng(3).Row > R                                       'Until(條件不成立,執行迴圈)
    
20.         Next
    
21.     Next
    
22. End Sub

複製代碼

joey3277

謝謝大大的幫忙！！趕緊試試

joey3277

請教一下kimbal 大大
使用你提供的程式碼遇到了一各問題
如果最後一個要合併的儲存格要合併的格數是兩格的話
程式碼就會抓不到最後一各
如提供的表上最後一格要合併的是15.16.17列這沒有問題
但如果只要合併15.16列  程式就只會執行到13列

PS.可另請教如果要合併的只有B欄
那你提供的程式碼要改哪邊呢?

joey3277

謝謝GBKEE 大大提供的程式碼
測試過了   超級方便好用

謝謝幫忙

GBKEE

回復 7# joey3277
修改如下

1. Option Explicit
   
2. Sub test()
   
3.     Dim lngRowCount As Long, Rng As Range, R As Range
   
4.     Dim lngRowCounter As Long
   
5.     Dim lngRowCountLast As Long
   
6.     On Error Resume Next                                                    '不理會程序上的錯誤,繼續執行程式
   
7.     Set Rng = Application.InputBox("選取儲存格(可選多重範圍)", Type:=8)     '如沒有選取儲存格:程序上的錯誤
   
8.     If Err <> 0 Then Exit Sub                                               '程序上有錯誤
   
9.     For Each R In Rng.Areas
   
10.         lngRowCount = R.Rows.Count                                          '範圍的總列數
    
11.         lngRowCountLast = 1
    
12.         For lngRowCounter = 2 To lngRowCount
    
13.             With R.Range("A1")
    
14.                 If .Offset(lngRowCounter) <> "" Or lngRowCounter = lngRowCount Then
    
15.                     If Not (lngRowCountLast = lngRowCounter - 1) Then
    
16.                         .Parent.Range(.Offset(lngRowCountLast), .Offset(lngRowCounter - 1)).Merge
    
17.                     End If
    
18.                     lngRowCountLast = lngRowCounter
    
19.                 End If
    
20.             End With
    
21.         Next
    
22.     Next
    
23. End Sub

複製代碼

joey3277

GBKEE 大大
你幫忙修改的程式碼  出現2各狀況
1.所選取的範圍第一各合併的儲存格的第一列都無法合併.如:1.2列要合併(無作用)如:1.2.3列要合併(2.3列會合併.但不會跟1列合併)如:1.2.3.4列要合併(2.3.4會合併.但1列還是無法一起合併)
是每次要選取合併範圍第一各合併都會有這種現象
2.如果是點選整欄就會最後一各合併儲存格無限大的往下延伸

PS原來kimbal 大大提供的程式碼產生的那各問題.在你修正的程式碼裡已解決

真不好意思  一直找麻煩:(