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

删除特定单元格上方的Excel中的一列行

1 个答案: