Vba Microsoft Excel从单独的列表中删除至少不包含1个关键字的所有短语行
在一个常规文本文件中，我有一个大约1000个不同关键字的列表（非常简单，它们都是没有空格的单字，每个关键字后面都有一个硬回车）Vba Microsoft Excel从单独的列表中删除至少不包含1个关键字的所有短语行,vba,excel,Vba,Excel,在一个常规文本文件中，我有一个大约1000个不同关键字的列表（非常简单，它们都是没有空格的单字，每个关键字后面都有一个硬回车） 关键字列表.txt 彼得 詹姆斯 约翰 玛丽 克里斯 然后我有一个Excel文件，在a列中列出了100000个不同的短语（每行一个短语） 我想从我的第一个列表中删除所有不包含至少1个关键字的行 phrases.xlsx（这些大多是长短语，有些长度超过254个字符，每行一个短语） 第1行“他和玛丽在这里”（保留这一行，因为有一个或多个我的关键字） 第2行“男孩叫彼得
关键字列表.txt 彼得 詹姆斯 约翰 玛丽 克里斯
然后我有一个Excel文件，在a列中列出了100000个不同的短语（每行一个短语） 我想从我的第一个列表中删除所有不包含至少1个关键字的行
phrases.xlsx（这些大多是长短语，有些长度超过254个字符，每行一个短语） 第1行“他和玛丽在这里”（保留这一行，因为有一个或多个我的关键字） 第2行“男孩叫彼得和克里斯”（保留这一行，因为有一个或多个我的关键字） 第3行“Michael和Ronald在那里”（注意：没有关键字，所以删除整行）
这可以单独在Excel中完成吗？还是我需要一个宏？ 如果事情不像看上去那么简单，请给我指引正确的方向。我不了解VBA或宏，但如果Excel中没有简单的方法，我会尽我最大的努力：） 谢谢
Alex更新：让我们在VBE中创建一个空白工作簿和一个新模块，然后粘贴到代码中，另存为启用宏的工作簿（.xlsm），更改宏安全设置，重新打开此.xlsm文件 在Excel中按Alt-F11打开Visual Basic 单击插入->模块 双击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
非VBA的做法是通过文本导入向导将文件导入工作簿中的另一个工作表。在原始工作表中，使用数组公式（不要忘记按住Ctrl+Shift+Enter键）并双击角点向下拖动：
=MAX（IFERROR（查找（关键字！$A$1:$A$5，$A1,1），0））=”“&$A1&”“重新执行公式以指向两个工作表中的临时列。在关键字范围中添加空格，确保只找到准确的短语；在短语中添加空格将确保找到短语以关键字开头或结尾的实例。我认为您必须使用VBA。您的关键字是要放在单独的文件中，还是要放在工作簿中单独的工作表中？写VBA的时候会有很大的不同。嗨，帕特里克，谢谢你的帮助！请原谅我的无知。。1.我打开了phrases.xlsx文件2。我转到“开发人员”选项卡，然后单击宏。在宏名称中：我输入“TestingMacroFromPatricK”，然后单击“Create”。3.它打开了VBA，我现在看到了：Sub Testing MacroFromPatrick（）End Sub 4。此时，我不知道需要将您提供给我的整个代码粘贴到哪里。我试着将它粘贴在中间，如下所示：subtestingmacrofromprick（）（我粘贴在这里）End Sub5。现在，当尝试保存时，它会显示：“以下功能无法保存在无宏工作簿.VB项目中。”我的选项是继续保存为无宏工作簿或选择启用宏的文件类型。所以我把它保存为“phrases.xlsm”。这对吗。此时，我仍然没有改变这一点：“更改下面这两个以匹配您的文件路径Const关键字file=“C:\Test\keywordslist.txt”Const PhrasesFile=“C:\Test\phrases.xlsx”，所以我现在将其更改为：Const PhrasesFile=“”更改下面这两个以匹配您的文件路径Const关键字file=”C:\Documents and Settings\Administrator\Desktop\keywordslist.txt“Const PhrasesFile=“C:\Documents and Settings\Administrator\Desktop\phrases.xlsx”\phrases.xlsx”现在我再次保存它，以防万一。在Excel中，我转到“开发者”选项卡，单击“宏”，我有两个选择要运行：“SO_19150262”或“TestingMacroFromPatricK”。我试图运行“TestingMacroFromPatricK”，得到一个“编译错误：预期的结束子”。所以我把它放进去保存。8.现在我尝试再次运行它，没有错误，但没有其他事情发生！所以我想。。也许现在我的“Const PhrasesFile=”应该指向新的“phrases.xlsm”？我试着改变道路，但也没有任何结果。因此，我尝试运行“So_19150262”，但得到了一个不同的编译错误：“ByRef参数类型不匹配”。这就是我被困的地方，我不知道如何继续：（nethy，再次感谢：）快速提问。。我得到了一些起始位置数字，而不是0，虽然complete关键字不在那里，但字符确实匹配，所以我怀疑。。数组公式是否可能查找所有字符的存在而不是完整字符