如何在每隔六行后删除五行？

Question

我需要在每6行之后删除5行，假设第一行是被忽略的第一行。例如：

Row 1 <-- want to keep
Row 2-6 <-- want to delete
Row 7 <-- want to keep
Row 8-12 <-- want to delete
etc., for all rows with values in column A

我尝试手动删除不需要的行，但意识到肯定有更好的方法。我确实查找了几个每隔一行删除的VBA示例，但我需要每隔这么多行删除一系列行，并且不确定如何处理。我也不确定如何修改代码，使A列中包含数据的所有行保持循环，而不仅仅是一个特定的集合。

Sub sbVBS_To_Delete_Rows_In_Range()
Dim iCntr
Dim rng As Range
Set rng = Range("A10:D20")

    For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next

End Sub

这似乎删除了一个行的范围，所以比以前更接近了。但是，我需要继续查找列A中包含日期的所有行。

Answer 1

我相信这就是你要找的东西：

Sub tgr()

    Dim ws As Worksheet
    Dim rStart As Range
    Dim rStop As Range
    Dim rTemp As Range
    Dim rDel As Range
    Dim lGroupSize As Long
    Dim i As Long

    Set ws = ActiveWorkbook.ActiveSheet
    Set rStart = ws.Columns("A").Find("*", ws.Cells(ws.Rows.Count, "A"), xlValues, xlPart)
    Set rStop = ws.Cells(ws.Rows.Count, "A").End(xlUp)
    lGroupSize = 5

    For i = rStart.Row To rStop.Row Step lGroupSize + 1
        Set rTemp = ws.Cells(i + 1, "A").Resize(lGroupSize)
        If rDel Is Nothing Then Set rDel = rTemp Else Set rDel = Union(rDel, rTemp)
    Next i

    If Not rDel Is Nothing Then rDel.EntireRow.Delete

End Sub

编辑：根据注释中的请求更新代码

Sub tgr()

    Dim ws As Worksheet
    Dim rStart As Range
    Dim rStop As Range
    Dim rTemp As Range
    Dim rDel As Range
    Dim sColCheck As String
    Dim lGroupSize As Long
    Dim i As Long, j As Long

    Set ws = ActiveWorkbook.ActiveSheet
    sColCheck = "A"
    lGroupSize = 5

    Set rStart = ws.Columns(sColCheck).Find("*", ws.Cells(ws.Rows.Count, sColCheck), xlValues, xlPart)
    Set rStop = ws.Cells(ws.Rows.Count, sColCheck).End(xlUp)

    i = rStart.Row
    Do While i <= rStop.Row
        Set rTemp = Nothing
        For j = 1 To lGroupSize
            If IsDate(ws.Cells(i + j, sColCheck)) Then
                Set rTemp = ws.Cells(i + 1, sColCheck).Resize(j)
                Exit For
            End If
        Next j
        If Not rTemp Is Nothing Then If rDel Is Nothing Then Set rDel = rTemp Else Set rDel = Union(rDel, rTemp)
        i = i + j + 1
    Loop

    If Not rDel Is Nothing Then rDel.EntireRow.Delete

End Sub

Answer 2

我希望这能为你工作，你可以通过任何你想要的范围和频率！

Sub sbVBS_To_Delete_Rows_In_Range(rg As Range, Optional frequency As Long = 5)
    Dim i As Long
    Dim rangeToDelete As String

    Dim cont As Long
    rangeToDelete = VBA.Split(rg.Cells(i, 1).Address, "$")(1) & (VBA.Split(rg.Cells(i, 1).Address, "$")(2) + 1) & ":" & VBA.Split(rg.Cells(i, 1).Address, "$")(1) & (VBA.Split(rg.Cells(i + frequency, 1).Address, "$")(2))
    For i = 1 To rg.Cells.count
        Range(rangeToDelete).Offset(i - 1).Select
        Range(rangeToDelete).Offset(i - 1).rows.Delete
    Next

End Sub