如何將 Excel 中的單元格與 VBA 與數百個數據集合並

Question

原始數據看起來像這樣在此處輸入圖像描述

我想讓下面的 VBA 代碼為數百個數據集復制數百次

`子合並CellsAndCenter()

   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 行），其值與 B 列到 C 中的數據集相關，Urdearboy 也對此進行了說明。

再次感謝大家。