宏以刪除行的特定范圍

Question

我有下面的宏，它刪除8行數據，剩下1行

Sub sbVBS_To_Delete_Rows_In_Range()
Dim iCntr
Dim rng, rng1, rng2, rng3 As Range
Set rng = Range("A9:A16")
Set rng1 = Range("A18:A25")
Set rng2 = Range("A27:A34")
Set rng3 = Range("A36:A43")
    For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next
 For iCntr = rng1.Row + rng1.Rows.Count - 1 To rng1.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next
     For iCntr = rng2.Row + rng2.Rows.Count - 1 To rng2.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next
     For iCntr = rng3.Row + rng3.Rows.Count - 1 To rng3.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next
End Sub

有什么辦法可以修改它，這樣我就不必手動指定范圍，例如，宏可以刪除跳過1行的8行，然后再次刪除跳過1行的8行

Answer 1

我建議以下內容：

Option Explicit

Public Sub Delete8RowsSkip1()
    Dim RangeToDelete As Range

    Dim LastRow As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    Dim iRow As Long
    For iRow = 9 To LastRow Step 9 'run from row 9 to last row in steps of 9
        If RangeToDelete Is Nothing Then 'first range
            Set RangeToDelete = Rows(iRow).Resize(RowSize:=8) 'collect first 8 rows to delete
        Else 'further ranges
            Set RangeToDelete = Union(RangeToDelete, Rows(iRow).Resize(RowSize:=8)) 'collect next 8 rows to delete
        End If
    Next iRow

    RangeToDelete.Delete 'delete all collected rows
End Sub

首先，我們在A列中找到最后使用的行，因此這就是For循環的結尾。 該循環一次執行9個步驟，然后收集接下來的8行並將其添加到RangeToDelete 。 最后，我們一次刪除所有收集的行（與逐行刪除相比，這非常快）。

請注意，這里不需要向后運行循環，因為我們最后一次刪除了所有行，這不會像在逐行刪除時那樣更改行計數。

---

編輯

以下示例考慮了@ComradeMicha在其評論中提到的內容。 這將使刪除的行與LastRow匹配。 如果除A列以外的其他列具有比A列更多的數據行，則可能需要這樣做。

Option Explicit

Public Sub Delete8RowsSkip1()
    Dim RangeToDelete As Range

    Dim LastRow As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    Dim DeleteRows As Long
    DeleteRows = 8

    Dim iRow As Long
    For iRow = 9 To LastRow Step 9
        If iRow + DeleteRows - 1 > LastRow Then DeleteRows = LastRow - iRow + 1

        If RangeToDelete Is Nothing Then
            Set RangeToDelete = Rows(iRow).Resize(RowSize:=DeleteRows)
        Else
            Set RangeToDelete = Union(RangeToDelete, Rows(iRow).Resize(RowSize:=DeleteRows))
        End If
    Next iRow

    RangeToDelete.Delete
End Sub