删除条件之间的行

Question

我要删除两个包含特定文本的单元格之间的所有行。

例如：单元格B16包含Description，单元格B28包含Transportation。我想删除包含Description和Transportation的单元格行之间的所有行。我需要一个VBA解决方案来解决这个问题。

非常感谢。普尼思

Answer 1

删除条件之间的行

更改常量部分中的值以适合您的需求。
首先使用Hide（Const cDel As Boolean = False）测试代码。确定可以满足您的要求后，将cDel更改为True即可删除关键行（Const cDel As Boolean = True）。
包含条件（说明，运输）的行将不被删除（隐藏）。
如果未找到任何条件，则该代码将无效。

代码

Sub HideDeleteDT()

    Const cSheet As Variant = "Sheet1"        ' Source Worksheet Name/Index
    Const cStr1 As String = "Description"     ' Criteria 1
    Const cStr2 As String = "Transportation"  ' Criteria 2
    Const cCol As Variant = "B"               ' Criteria Column Letter/Number
    Const cDel As Boolean = False             ' Enable Delete(True), Hide(False)

    Dim Find1 As Range  ' Criteria 1 Cell Range
    Dim Find2 As Range  ' Criteria 2 Cell Range
    Dim LCell As Range  ' Last Cell in Criteria Column

    ' In Source Worksheet
    With ThisWorkbook.Worksheets(cSheet)
        ' In Criteria Column
        With .Columns(cCol)
            ' Assign last cell range in Criteria Column to variable.
            Set LCell = .Cells(.Cells.Count)
            ' Find Criteria 1 and assign the found cell range to variable.
            Set Find1 = .Find(cStr1, LCell, xlValues, xlWhole, xlByColumns)
        End With
        ' Check if Criteria 1 was found.
        If Not Find1 Is Nothing Then
            ' Find Criteria 2 and assign the found cell range to variable.
            Set Find2 = .Range(Find1.Offset(1), LCell).Find(cStr2, LCell)
            ' Check if Criteria 2 was found.
            If Not Find2 Is Nothing Then
                ' To prevent hiding or deleting rows of the Criteria Cell Ranges
                ' after Critical Rows have already been deleted (Delete) or(and)
                ' the Criterias are in concecutive rows (Hide).
                If Find1.Row + 1 < Find2.Row Then
                    ' Hide or delete rows between found Criteria Cell Ranges.
                    If cDel Then ' Delete (Unsafe). You will lose data.
                        .Rows(Find1.Row + 1 & ":" & Find2.Row - 1).Delete
                      Else       ' Hide (Safe). No loss of data.
                        ' Show all rows to visualize what exactly is being
                        ' hidden by the code each time i.e. if rows have
                        ' previously been hidden it would be unclear which ones
                        ' have been hidden each ('this') time.
                        .Rows.Hidden = False
                        .Rows(Find1.Row + 1 & ":" & Find2.Row - 1).Hidden = True
                    End If
                End If
            End If
        End If
    End With

End Sub

查找方法备注

第一个参数 What 包含要搜索的数据，并且必填。所有其他参数都是可选的。
第二个参数之后设置为“最后一个单元格”，之后开始从省略号所指示的列（范围）的第一个（上部（左侧））单元中搜索” 默认 SearchDirection 参数xlNext。
第3，第4和第5个参数 LookIn ， LookAt 和 SearchOrder ，每次都会保存，因此可以在第二个Search（Set Find2 = ...）中省略。
- 查找设置为xlValues以防止搜索公式（或注释）。
- LookAt 设置为xlWhole以防止发现单元格中 What 参数的一部分，例如找不到Type Description。
- SearchOrder ，因为我们在单列范围内进行搜索。
第6个参数 SearchDirection ，默认为 xlNext，其中在代码中使用，因此可以安全地省略。
第7个参数 MatchCase ，默认为 False，不是在OP的问题中解决，因此将其省略。

Answer 2

您可以编写一个辅助函数，该函数接受要扫描的范围，要搜索的文本以及所找到的范围作为参数，并在实际找到所找到的范围时返回True：

Function GetCellWithText(rngToScan As Range, txtToSearch As String, foundRng As Range) As Boolean
    With rngToScan
        Set foundRng = .Find(what:=txtToSearch, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, after:=.Cells(.Count))
    End With
    GetCellWithText = Not foundRng Is Nothing
End Function

并在您的主要代码中使用它，如下所示：

Option Explicit

Sub DeleteRowsBetweenCellsWithSpecificTexts()
    Dim txt1Rng As Range, txt2Rng As Range

    With Range("B1", Cells(Rows.Count, 2).End(xlUp)) ' reference currently active sheet column B range from row 1 down to last not empty one
        If Not GetCellWithText(.Cells, "Description", txt1Rng) Then Exit Sub ' if first text not found do nothing
        If Not GetCellWithText(.Cells, "Transportation", txt1Rng) Then Exit Sub ' if second text not found do nothing

        If txt2Rng.Row = txt1Rng.Row + 1 Then Exit Sub ' if found cells are adjacent then do nothing
    End With

    Range(txt1Rng.Offset(1), txt2Rng.Offset(-1)).Delete
End Sub

此代码作用于当前活动的工作表

如果您需要在特定工作表上运行它，则只需在Range调用（即Worksheets("MySheetName").Range(...)）之前先输入适当的工作表规格

Excel删除两个特定单元格之间的行

2 个答案:

删除条件之间的行

代码

查找方法备注