如何在Excel中用VBA合并单元格，有几百个数据集。

Question

原始数据是这样的请在此输入图片描述

我想让下面的VBA代码复制几百个时间的几百个数据集。

`Sub mergeCellsAndCenter()

   With Worksheets("Sheet1").Range("C5:C6")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge
     End With

     With Worksheets("Sheet1").Range("D5:D6")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge
     End With

     With Worksheets("Sheet1").Range("E5:E6")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge
     End With


    With Worksheets("Sheet1").Range("C7:C8")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge
     End With

     With Worksheets("Sheet1").Range("D7:D8")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge
     End With

     With Worksheets("Sheet1").Range("E7:E8")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge
     End With

     With Worksheets("Sheet1").Range("C9:C10")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge 
     End With

     With Worksheets("Sheet1").Range("D9:D10")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge
     End With

     With Worksheets("Sheet1").Range("E9:E10")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Merge
     End With

End Sub`当我运行这个宏时，它对10行有效。我想让它为数百行工作，而不必键入每个集合的代码。"

Answer 1

任何时候，当你发现自己在写重复的代码时，很有可能会错过实现循环的机会。你很幸运，这里就是这种情况。

在你的行中循环（间隔为2），并分别合并你的3列的值。也最好等到你的循环完成后再去格式化你的单元格。不需要在循环里面重复同样的操作。这可能证明是耗时的当你完成循环后，你可以一次性格式化整个范围。

---

Sub Shelter_In_Place()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long

lr = ws.Range("C" & ws.Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

    For i = 5 To lr Step 2
        ws.Range("C" & i).Resize(2).Merge
        ws.Range("D" & i).Resize(2).Merge
        ws.Range("E" & i).Resize(2).Merge
    Next i

    With ws.Range("C5:E" & lr)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

Application.ScreenUpdationg = True

End Sub

Answer 2

我看了链接。 根据我所看到的，这些看起来像空白行。 我的眼睛不是很好，但它看起来像空行给我。 如果你想删除你的使用范围内的所有空白行，只需运行下面的脚本。

Public Sub DeleteBlankRows()
    Dim SourceRange As Range
    Dim EntireRow As Range

    Set SourceRange = Application.Selection

    If Not (SourceRange Is Nothing) Then
        Application.ScreenUpdating = False

        For I = SourceRange.Rows.Count To 1 Step -1
            Set EntireRow = SourceRange.Cells(I, 1).EntireRow
            If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
                EntireRow.Delete
            End If
        Next

        Application.ScreenUpdating = True
    End If
End Sub

Answer 3

代码是有效的。非常感谢你。

@ ASH，谢谢你的意见，尽管这不是你的要求。

合并单元格与每一行下面的空白单元格是简单地应用于列B到E，从第05行开始，循环完成有值的单元格。F列到H列将包含下拉列表（第5行和第6行），其值与Urdearboy所说明的B列到C列的数据集有关。

再次感谢大家。