0

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

我认为下面链接上的代码很接近，但这并不是指范围。另外，我只需要搜索一个名为“FAIR”的工作表。 VBA循环工作表：如果单元格不包含则删除行

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

4

2 回答 2

1

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

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

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

于 2013-09-26T05:26:50.160 回答
0

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

此代码改编自另一个站点，由于某种原因，我无法在此处粘贴链接。

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

    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

如果您需要进一步的帮助，请告诉我。

于 2013-09-26T06:26:23.230 回答