0

25k 行のデータ シートがあります。「KeywordSearh」と呼ばれるタブ 2 の名前付き範囲で定義した特定の単語をシート全体で検索する必要があります。範囲には、メイン データで検索する必要がある単語のリストが含まれています。これらのキーワードを含まないすべての行を削除し（保持しているすべての行を上に移動し）、キーワードを参照する行のみを保持したい（タイトル行を含む）。キーワードは、他のテキストも含む任意のセル内にテキストとして書き込むことができるため、検索機能は各文字列内を検索する必要があり、大文字と小文字を区別する必要はありません。

以下のリンクのコードは近いと思いますが、これは範囲を参照していません。また、「FAIR」という名前の 1 つのワークシートを検索するだけで済みます。 シート上の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 に答える