Microsoft Excel從單獨的列表中刪除不包含至少一個關鍵字的所有行短語

Question

在一個常規文本文件中，我有一個包含約1,000個不同關鍵字的列表（非常簡單，它們都是單個單詞，沒有空格並且每個關鍵字之後都有一個很難的回報）。

---

keywordslist.txt

彼得

詹姆斯

約翰

瑪麗

克里斯

---

然後，我有一個Excel文件，列A中有100000個不同的短語（每行一個短語）。

我想從我的第一個列表中刪除所有不包含至少一個關鍵字的行。

---

phrases.xlsx（這些大多是長短語，長一些超過254個字符每行，一個短語）

行1「他和瑪麗是這裏」（保持這一行，因爲有一以上我的關鍵字）

第2行的「叫彼得和克里斯男孩」（保持這一行，因爲有一個或多個關鍵字的）

第3行「邁克爾和Ronald有沒有」（注意：關鍵字都不存在，所以刪除整個行）

---

可這僅在Excel中做了什麼？或者我需要一個宏？ 如果它看起來不那麼簡單，請引導我朝着正確的方向發展。我沒有VBA或宏的知識，但我會給我最好的嘗試，如果有在Excel中沒有簡單的方法:) 謝謝， 亞歷克斯

Answer 1

非VBA做到這一點是通過導入文件文本導入嚮導到工作簿中的另一個工作表。在你原來的工作表，使用數組公式（不要忘記按Ctrl + Shift + Enter鍵），然後雙擊角落拖累：

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

關鍵詞是你的工作與進口數據，A1是你的第一個短語所在的單元格，假設你在B1中輸入了這個公式。您將獲得一系列的起始位置編號，任何零值表示在短語中沒有找到任何關鍵字 - 這是IFERROR公式中的0。然後可以通過0過濾B列並刪除可見單元格（選擇> Ctrl + G>特殊>僅可見單元格>刪除行）。

在上面提供的示例中，第一個公式將生成（0,0,0,9,0）。 MAX然後選出最高的數字。

編輯

正如在評論中討論，這也將拿起諧音，如發現在「大災難」，「貓」。要解決這一點，你可以創建兩個工作表一個臨時列，前後關鍵字和詞組後添加一個空格：

​​

重新做公式指向工作表都暫時列。爲關鍵字範圍添加空格可確保它僅找到該確切短語;爲短語添加空格將確保它能夠找到短語以關鍵字開頭或結尾的實例。

Answer 2

UPDATE：讓我們創建一個空白工作簿，並在一個新的模塊VBE然後粘貼代碼，保存爲啓用宏的工作簿（.xlsm），更改宏安全設置，重新打開這個.xlsm文件。

按Alt-F11在Excel中打開Visual Basic中

單擊插入 - >模塊

鼠標雙擊模塊1或不管它剛剛創建

粘貼在下面的代碼中

在Excel

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宏-Enabled工作簿」

在開發選項卡，單擊宏安全（我猜你會不會簽署您的宏，以便改變使這一切宏）

選擇啓用所有宏...然後單擊確定

關閉並重新打開此.XLSM然後單擊宏在開發人員選項卡，選擇SO_19150262並單擊運行：