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

如何在每第六行之后删除五行？

2 个答案: