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并单击运行：