根据条件选择 3 行，然后删除整行，查找下一行，重复到最后一行。一行代码导致运行时错误“1004”

Question

使用Excel 2019 VBA

在名为“测试”的工作表中的当前工作簿中，有两种方法可以将数据垂直向下显示在工作表中。

纸张的大小从 1000 行到一些 8000 行甚至更多。 彼此相关的每组或一组行均由空白行分隔。 一组数据（我需要保留）始终位于 8 - 15 行中。 我想要删除整个实际行的另一组始终位于 3 行中，其中 A 行中的文本对于每组始终相同。

A 行本质上是一个垂直标题，每组相关数据之间有一个空白行，我尝试使用 A 列中的文本来选择三行并删除整行。

我的代码逻辑是： 向下查看 A 列并选择第一个包含值或文本“完整名称”的单元格。 然后计算该列的第 2 行，如果该行为空，请记住该行。 接下来倒数 4 行（如果该行为空），选择中间的行并删除整行。 然后转到下一个值或文本“完整名称”并重复上述步骤。

我使用计数行方法，因为文本“完整名称”也出现在我想要保留的行组或行集（具有 8 - 15 个关联行的行）中，以便 VBA 能够将两组或一组分开计数行方法似乎是一个不错的选择。

我已经尝试了代码中的许多变体，但我无法确定它，因为它不断出现运行时错误“1004”：由行

If i - 4 >= 1 And ws.Cells(i - 4, 1).Value = """" Then

和使用2 x双引号

引起的应用程序定义或对象定义错误If i - 4 >= 1 And ws.Cells(i - 4, 1).Value = "" Then

这是我的代码。我添加了注释来解释代码的作用。

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim cell As Range
    Dim blankRow As Boolean
    
    ' Sets the reference to "Test" worksheet
    Set ws = ThisWorkbook.Sheets("Test")
    
    ' Count up and find last used row in Column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    'Look for the first cell with "Complete name and then count up 2 rows and check if row is blank"
    For i = 1 To lastRow
        ' Check if cell contains "Complete name"
        If InStr(1, ws.Cells(i, 1).Value, "Complete name", vbTextCompare) > 0 Then
            ' Count up 2 rows
            If i + 2 <= lastRow Then
                Set cell = ws.Cells(i + 2, 1)
                ' Check if selected cell is blank
                If cell.Value = "" Then
                    ' Remember cell address
                    Dim cellAddress As String
                    cellAddress = cell.Address
                    blankRow = True
                End If
            End If
            
            ' Count down 4 rows and if cell is blank, remove rows in-between the two blank rows
            If blankRow Then
                If i - 4 >= 1 And ws.Cells(i - 4, 1).Value = """" Then
                    ws.Rows(i - 4 & ":" & i + 2).EntireRow.Delete
                    blankRow = False
                    i = i - 4
                    lastRow = lastRow - 3
                End If
            End If
        End If
    Next i
End Sub```

Answer 1

• 收集所有所需的行作为 Range 对象，一次删除所有行。

Option Explicit

Sub RemoveRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    ' Sets the reference to "Test" worksheet
    Set ws = ThisWorkbook.Sheets("Test")
    ' Count up and find last used row in Column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Dim arrData: arrData = ws.Range("A1:A" & lastRow).Value
    Dim i As Long, j As Long, rDel As Range
    For i = LBound(arrData) + 4 To UBound(arrData) - 2
        If InStr(1, arrData(i, 1), "Complete name", vbTextCompare) > 0 Then
            If Len(arrData(i - 4, 1)) = 0 And Len(arrData(i + 2, 1)) = 0 Then
                If rDel Is Nothing Then
                    Set rDel = ws.Cells(i - 4, 1).Resize(7, 1)
                Else
                    Set rDel = Union(rDel, ws.Cells(i - 4, 1).Resize(7, 1))
                End If
            End If
        End If
    Next
    If Not rDel Is Nothing Then
        rDel.EntireRow.Delete
    End If
End Sub