宏以删除行的特定范围

时间:2018-08-20 08:20:50

标签: excel vba excel-vba

我有下面的宏,该宏删除了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行

1 个答案:

答案 0 :(得分:2)

我建议以下内容:

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