Question

我有一张25k行的数据。我需要在整个工作表中搜索我在选项卡2的命名区域中定义的某些单词，称为“KeywordSearh”。该范围包含我需要在主数据中查找的单词列表。我想删除所有不包含这些关键字的行（并向上移动所有保留行）并仅保留引用关键字（包括标题行）的行。关键字可以作为文本写入任何单元格中，也可以包含其他文本，因此搜索功能需要在每个字符串中查看，而不是特定于案例。

我认为下面链接上的代码很接近，但这并不是指范围。另外，我只需要搜索一个名为“FAIR”的工作表。 VBA Looping Over Sheets: Delete rows if cell doesn't contain

我是VBA的新手，所以非常感谢任何帮助。

Answer 1

这是一种非VBA方式。选择要更改的范围，转到条件格式＆gt; <高亮细胞规则>更多规则＆gt;使用公式确定要格式化的单元格。选择一种颜色以突出显示单元格，并使用您的范围键入此公式：

=COUNTIF(FAIR!$A$1:$A$10,A1)凡公平！$ A $ 1：$ 10美元是您的关键字范围，A1是您尝试更改范围的第一个单元格。

然后，您可以按颜色=无填充过滤列表，仅选择并删除可见单元格（Ctrl + G＆gt;特殊＆gt;仅可见单元格）。

Answer 2

下面的过程在整个工作表中搜索一个值数组，然后删除工作表中找不到这些值的所有行。

此代码改编自其他网站，由于某些原因我无法在此处粘贴链接。

首先，您需要创建一个函数来查找最后一行：

    Public Function GetLastRow(ByVal rngToCheck As Range) As Long

    Dim rngLast As Range

    Set rngLast = rngToCheck.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

    If rngLast Is Nothing Then
        GetLastRow = rngToCheck.Row
    Else
        GetLastRow = rngLast.Row
    End If

End Function

现在，使用下面的代码查找数组上的值。它将搜索整个工作表并删除未找到该值的任何行。

    Sub Example1()

    Dim varList As Variant
    Dim lngarrCounter As Long
    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress As String

    Application.ScreenUpdating = False

    varList = VBA.Array("Here", "There", "Everywhere") 'You will need to change this to reflect your Named range

    For lngarrCounter = LBound(varList) To UBound(varList)

        With Sheets("Fair").UsedRange 'Change the name to the sheet you want to filter
            Set rngFound = .Find( _
                                What:=varList(lngarrCounter), _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)

            If Not rngFound Is Nothing Then
                strFirstAddress = rngFound.Address

                If rngToDelete Is Nothing Then
                    Set rngToDelete = rngFound
                Else
                    If Application.Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
                End If

                Set rngFound = .FindNext(After:=rngFound)

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

    If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

    Application.ScreenUpdating = True

End Sub

如果您需要进一步的帮助，请与我们联系。

vba删除不包含范围中定义的设置值的行

2 个答案: