在特定单元格上方的excel中删除行的列

Question

我现在是一个非常新手的程序员，但是我正在处理一个Excel电子表格，我需要删除其中的行。

例如。

<1>
Title 1
xyz
Title 2
xyz
Title 3
xyz
xyz
xyz
Title 4
xyz

每行都在Excel中的新行上，其中大约有1412。 我需要删除一些标题和内容，但保留其他标题和内容。 通过下面找到并修改的代码，我能够删除单行内容的标题，但是不能使它适用于多行内容的标题。 标题3及其下面的3行内容。

任何帮助将不胜感激

---

Sub removeSingleRows()

Const strTOFIND As String = "Title 1"

    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress As String

    Application.ScreenUpdating = False

    With Sheet1.Range("A:A")
        Set rngFound = .Find( _
                            What:=strTOFIND, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=True)

        If Not rngFound Is Nothing Then
            Set rngToDelete = rngFound

            strFirstAddress = rngFound.Address

            Set rngFound = .FindNext(After:=rngFound)

            Do Until rngFound.Address = strFirstAddress
                Set rngToDelete = Application.Union(rngToDelete, rngFound)
                Set rngFound = .FindNext(After:=rngFound)
            Loop
        End If
    End With

    If Not rngToDelete Is Nothing Then
    rngToDelete.Offset(1, 0).EntireRow.Delete
    rngToDelete.EntireRow.Delete
    End If

    Application.ScreenUpdating = True

End Sub

Answer 1

像这样的东西

• 遍历要查找的单词数组
• 更新多次搜索的范围逻辑

码

Sub removeSingleRows()

Dim strArr()
Dim strArrE
Dim rngFound As Range
Dim rngToDelete As Range
Dim strFirstAddress As String

strArr = Array("Title 1", "Title 2", "Title 3")

Application.ScreenUpdating = False

For Each strArrE In strArr
    With Sheets(1).Range("A:A")
        Set rngFound = .Find(CStr(strArrE), , xlValues, xlWhole, xlByRows, xlNext, True)

        If Not rngFound Is Nothing Then
            If rngToDelete Is Nothing Then
            Set rngToDelete = rngFound
            Else
            Set rngToDelete = Application.Union(rngToDelete, rngFound)
            End If
            strFirstAddress = rngFound.Address
            Set rngFound = .FindNext(After:=rngFound)
            Do Until rngFound.Address = strFirstAddress
                Set rngToDelete = Application.Union(rngToDelete, rngFound)
                Set rngFound = .FindNext(After:=rngFound)
            Loop
        End If
    End With
    Set rngFound = Nothing
 Next

    If Not rngToDelete Is Nothing Then
    rngToDelete.Offset(1, 0).EntireRow.Delete
    rngToDelete.EntireRow.Delete
    End If

    Application.ScreenUpdating = True

End Sub