Как удалить пять строк после каждой шестой строки?

Question

Мне нужно удалить 5 строк после каждой 6-й строки, предполагая, что первая строка является первой, которая игнорируется.Например:

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, которые удаляют каждую вторую строку, но мне нужно удалять диапазон строк каждые так, и я не знаю, как с этим справиться.Я также не уверен, как изменить код, чтобы продолжать цикл для всех строк, в которых есть данные в столбце А, а не только в конкретном наборе.

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

Это похоже на удаление одного диапазона строк, так что это ближеЯ был раньшеОднако мне нужно продолжать работать со всеми строками, которые содержат дату в столбце А.

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