Question

在一个常规文本文件中，我有一个大约1,000个不同关键字的列表（非常简单。它们都是没有空格的单个单词，并且在每个关键字后都有一个硬回复）。

keywordslist.txt

彼得

詹姆斯

约翰

玛丽

克里斯

然后我有一个Excel文件，其中包含A列中100,000个不同短语的列表（每行一个短语）。

我想删除第一个列表中不包含至少1个关键字的所有行。

phrase.xlsx（这些是长短语，有些超过254个字符，每行一个短语）

第1行“他和玛丽在这里”（保留此行因为有一个或多个关键字）

第2行“这个男孩叫彼得和克里斯”（保留此行，因为我的一个或多个关键字）

第3行“迈克尔和罗纳德在那里”（注意：没有关键字存在，所以删除整行）

这可以单独在Excel中完成吗？或者我需要一个宏？如果它看起来不那么简单，请指导我正确的方向。我不知道VBA或宏，但如果在Excel中没有简单的方法，我会尽力尝试:) 谢谢，亚历

Answer 1

执行此操作的非VBA将通过文本导入向导将文件导入工作簿中的另一个工作表。在原始工作表中，使用数组公式（不要忘记按Ctrl + Shift + Enter）并双击角落以向下拖动：

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

关键字是包含导入数据的工作表，A1是您的第一个短语所在的单元格，假设您在B1中输入了此公式。您将获得一系列起始位置编号，任何零值表示在短语中找不到任何关键字 - 这是IFERROR公式中的0。然后，您可以将列B过滤0并删除可见单元格（选择＆gt; Ctrl + G＆gt;特殊＆gt;仅可见单元格＆gt;删除行）。

在上面提供的示例中，第一个公式将产生（0,0,0,9,0）。然后MAX选出最高的数字。

修改的

正如评论中所讨论的那样，这也将获得部分内容，例如在“灾难”中找到“猫”。要解决此问题，您可以在两个工作表中创建临时列，在关键字和短语之前和之后添加空格：

=" "&$A1&" "

重新执行公式以指向两个工作表中的临时列。在关键字范围中添加空格可确保它只找到那个确切的短语;在短语中添加空格将确保它会找到短语以关键字开头或结尾的实例。

Answer 2

更新：让我们在VBE中创建一个空白工作簿和一个新模块然后粘贴代码，保存为启用宏的工作簿（.xlsm），更改宏安全设置，重新打开此.xlsm文件

在Excel中按Alt-F11以打开Visual Basic

点击插入 - ＆gt;模块

Insertmodule

双击Module1或刚刚创建的任何内容

Module1

粘贴在下面的代码中

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中，另存为 - ＆gt; “Excel启用宏的工作簿”

SaveAs

在“开发人员”选项卡中，单击“宏安全性”（我猜您不会签署您的宏，因此请更改以启用所有宏）

MacroSecurity

选择启用所有宏...然后单击确定

EnableAllMacro

关闭并重新打开此.xlsm并单击开发人员选项卡中的宏，选择SO_19150262并单击运行：

RunMacro

Microsoft Excel从单独的列表中清除了不包含至少1个关键字的所有短语行

2 个答案: