使用vba代碼合併動態範圍，然後循環

Question

我需要幫助來創建一個代碼來合併從列1到25，然後從列30到40列中的五個單元格，然後循環行再次合併五個單元格。

例如，我有一張工作表，其中包含從A3到au3的數據。在這裏，我希望範圍A3：A7，B3：B7，C3：C7等到Y3：Y7的每個單元格應該合併，然後保持範圍Z3：AD3原樣併合並AE3：AE7到AN3的下一個範圍： AN7。

然後循環倒行再次五個格

我使用這個代碼，但它太複雜，而且運作非常緩慢，無法正常工作「對於週中每個工作表」

任何提示幫助合併...................

Sub mergecells() 
Application.DisplayAlerts = False 
Dim Wks As Worksheet 
Dim i As Integer, j As Integer, x As Integer 
On Error Resume Next 
With Wks("Employee Data") 
For each Worksheet In Wks 
For i = 1 To 24 

Range(Cells(3, i), Cells(7, i)).Merge 
Range(Cells(8, i), Cells(12, i)).Merge 
Range(Cells(13, i), Cells(17, i)).Merge 
Range(Cells(18, i), Cells(22, i)).Merge 
Range(Cells(23, i), Cells(27, i)).Merge 
Range(Cells(28, i), Cells(32, i)).Merge 
Range(Cells(33, i), Cells(37, i)).Merge 
Range(Cells(38, i), Cells(42, i)).Merge 
Range(Cells(43, i), Cells(47, i)).Merge 
Range(Cells(48, i), Cells(52, i)).Merge 
Range(Cells(53, i), Cells(57, i)).Merge 
Range(Cells(58, i), Cells(62, i)).Merge 
Range(Cells(63, i), Cells(67, i)).Merge 
Range(Cells(68, i), Cells(72, i)).Merge 
Range(Cells(73, i), Cells(77, i)).Merge 
Range(Cells(78, i), Cells(82, i)).Merge 
Range(Cells(83, i), Cells(87, i)).Merge 
Range(Cells(88, i), Cells(92, i)).Merge 
Range(Cells(93, i), Cells(97, i)).Merge 
Range(Cells(98, i), Cells(102, i)).Merge 

For j = 33 To 37 

Range(Cells(3, j), Cells(7, j)).Merge 
Range(Cells(8, j), Cells(12, j)).Merge 
Range(Cells(13, j), Cells(17, j)).Merge 
Range(Cells(18, j), Cells(22, j)).Merge 
Range(Cells(23, j), Cells(27, j)).Merge 
Range(Cells(28, j), Cells(32, j)).Merge 
Range(Cells(33, j), Cells(37, j)).Merge 
Range(Cells(38, j), Cells(42, j)).Merge 
Range(Cells(43, j), Cells(47, j)).Merge 
Range(Cells(48, j), Cells(52, j)).Merge 
Range(Cells(53, j), Cells(57, j)).Merge 
Range(Cells(58, j), Cells(62, j)).Merge 
Range(Cells(63, j), Cells(67, j)).Merge 
Range(Cells(68, j), Cells(72, j)).Merge 
Range(Cells(73, j), Cells(77, j)).Merge 
Range(Cells(78, j), Cells(82, j)).Merge 
Range(Cells(83, j), Cells(87, j)).Merge 
Range(Cells(88, j), Cells(92, j)).Merge 
Range(Cells(93, j), Cells(97, j)).Merge 
Range(Cells(98, j), Cells(102, j)).Merge 

For x = 41 To 48 

Range(Cells(3, x), Cells(7, x)).Merge 
Range(Cells(8, x), Cells(12, x)).Merge 
Range(Cells(13, x), Cells(17, x)).Merge 
Range(Cells(18, x), Cells(22, x)).Merge 
Range(Cells(23, x), Cells(27, x)).Merge 
Range(Cells(28, x), Cells(32, x)).Merge 
Range(Cells(33, x), Cells(37, x)).Merge 
Range(Cells(38, x), Cells(42, x)).Merge 
Range(Cells(43, x), Cells(47, x)).Merge 
Range(Cells(48, x), Cells(52, x)).Merge 
Range(Cells(53, x), Cells(57, x)).Merge 
Range(Cells(58, x), Cells(62, x)).Merge 
Range(Cells(63, x), Cells(67, x)).Merge 
Range(Cells(68, x), Cells(72, x)).Merge 
Range(Cells(73, x), Cells(77, x)).Merge 
Range(Cells(78, x), Cells(82, x)).Merge 
Range(Cells(83, x), Cells(87, x)).Merge 
Range(Cells(88, x), Cells(92, x)).Merge 
Range(Cells(93, x), Cells(97, x)).Merge 
Range(Cells(98, x), Cells(102, x)).Merge 

Next   
Next 
Next 
Next 
Columns.VertxcalAlxgnment = xlVAlxgnCenter 
Applxcatxon.DxsplayAlerts = True 

End Sub 

Answer 1

下面的代碼將根據Worksheets("Employee Data")您的文章合併範圍，該代碼在不到一秒鐘的運行。

Option Explicit 

Sub MergeCells() 

Dim ws As Worksheet 
Dim lCol As Long, lRow As Long 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

For Each ws In ThisWorkbook.Worksheets 
    With ws 
     For lRow = 3 To 33 Step 5 ' you can increase beyond row 33 
      For lCol = 1 To 25 
       .Range(.Cells(lRow, lCol), .Cells(lRow + 4, lCol)).Merge 
      Next lCol 
      For lCol = 30 To 40 
       .Range(.Cells(lRow, lCol), .Cells(lRow + 4, lCol)).Merge 
      Next lCol 
     Next lRow 
    End With 
Next ws 
Application.DisplayAlerts = True 
Application.ScreenUpdating = True 

End Sub