vba - Microsoft Excel は、別のリストから少なくとも 1 つのキーワードを含まないフレーズのすべての行を除外します

Question

1 つの通常のテキストファイルには、約 1,000 の異なるキーワードのリストがあります (非常に簡単です。これらはすべてスペースのない単一の単語であり、各キーワードの後にハードリターンがあります)。

キーワードリスト.txt

ピーター

ジェームズ

ジョン

メアリー

クリス

次に、列 A (行ごとに 1 つのフレーズ) に 100,000 の異なるフレーズのリストを含む Excel ファイルがあります。

最初のリストから少なくとも 1 つのキーワードを含まないすべての行を削除したいと考えています。

phrases.xlsx (これらはほとんどが長いフレーズで、一部は 254 文字を超え、行ごとに 1 つのフレーズです)

行 1 「彼とメアリーはここにいます」 (私のキーワードが 1 つ以上あるため、この行はそのままにしておきます)

行 2 "The boy called Peter and Chris " (私のキーワードが 1 つ以上あるため、この行はそのままにしておきます)

行 3 「Michael and Ronald are there」 (注意: キーワードが存在しないため、この行全体を削除してください)

これはExcelだけでできますか？それともマクロが必要ですか？見た目ほど単純ではない場合は、正しい方向に導いてください。VBA やマクロの知識はありませんが、Excel で簡単な方法がない場合は、最善を尽くします :) ありがとう、アレックス

score 1 · Accepted Answer

これを行うための非 VBA は、テキストインポートウィザードを使用してファイルをブック内の別のシートにインポートすることです。元のワークシートで、配列数式を使用し (Ctrl+Shift+Enter を忘れずに)、角をダブルクリックして下にドラッグします。

=MAX(IFERROR(FIND(Keywords!$A$1:$A$5,$A1,1),0))

Keywords はインポートされたデータを含むワークシートです。A1 は最初のフレーズが入っているセルです。この数式を B1 に入力したとします。一連の開始位置番号が表示されます。ゼロは、フレーズ内にキーワードが見つからなかったことを意味します。これは、IFERROR 式の 0 です。次に、列 B を 0 でフィルター処理し、表示されているセルを削除できます ([> Ctrl+G] > [特殊] > [表示セルのみ] > [行の削除] を選択)。

上記の例では、最初の式は (0, 0, 0, 9, 0) になります。次に、MAX は最大数を選択します。

編集

コメントで説明されているように、これは「大惨事」で「猫」を見つけるなどのパーシャルもピックアップします。これを回避するには、両方のワークシートに一時的な列を作成し、キーワードとフレーズの前後にスペースを追加します。

=" "&$A1&" "

両方のワークシートの一時的な列を指すように数式をやり直してください。キーワードの範囲にスペースを追加すると、その正確なフレーズのみが検出されるようになります。フレーズにスペースを追加すると、フレーズがキーワードで開始または終了するインスタンスが確実に検出されます。

score 0 · Accepted Answer

更新: VBE で空白のワークブックと新しいモジュールを作成し、コードを貼り付けて、マクロが有効なワークブック (.xlsm) として保存し、マクロのセキュリティ設定を変更して、この .xlsm ファイルを再度開きます。

Excel で Alt-F11 を押して Visual Basic を開きます

[挿入] -> [モジュール] をクリックします

挿入モジュール

Module1 またはそれが作成したものをダブルクリックします

モジュール1

以下のコードを貼り付けます

Const ForReading = 1
' Change these two below to match your file path
Const KeyWordsFile = "C:\Test\keywordslist.txt"
Const PhrasesFile = "C:\Test\phrases.xlsx"    

Sub SO_19150262()
    Dim aKeywords As Variant, oWB As Workbook, oWS As Worksheet
    Dim R As Long, i As Long, bDelete As Boolean, sTmp As String

    Application.ScreenUpdating = False
    ' Read the Keywords file into aKeywords (array)
    aKeywords = GetKeywords(KeyWordsFile)
    Set oWB = Workbooks.Open(Filename:=PhrasesFile, ReadOnly:=False)
    Set oWS = oWB.Worksheets("Sheet1") ' Change this to match yours
    ' Start comparing from bottom of used data
    For R = oWS.UsedRange.Cells.SpecialCells(xlLastCell).Row To 1 Step -1
        bDelete = True
        sTmp = "Deleting Row " & R
        For i = 0 To UBound(aKeywords)
            If Len(aKeywords(i)) > 0 Then
                Application.StatusBar = "Checking Row " & R & " for keyword """ & aKeywords(i) & """..."
                If InStr(1, oWS.Cells(R, 1).Value, aKeywords(i), vbTextCompare) > 0 Then
                    sTmp = "Keeping Row " & R & ", Keyword(" & i & "):""" & aKeywords(i) & """"
                    bDelete = False
                    Exit For
                End If
            End If
        Next
        Debug.Print sTmp
        If bDelete Then oWS.Rows(R).Delete
    Next
    oWB.Save
    Set oWS = Nothing
    Set oWB = Nothing
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub

Private Function GetKeywords(sKeyFile As String) As Variant
    Dim aKeys As Variant, oFSO As Variant, oFile As Variant

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.OpenTextFile(KeyWordsFile, ForReading)
    If (oFile.AtEndOfStream) Then
        aKeys = Array()
    Else
        aKeys = Split(oFile.ReadAll, vbCrLf) ' Might need to change to vbCr or vbLf if unix text file
    End If
    Set oFile = Nothing
    Set oFSO = Nothing
    GetKeywords = aKeys
End Function

次にExcelで、名前を付けて保存->「Excelマクロ有効ブック」

名前を付けて保存