Excel VBA自定义函数从另一个string中删除出现在一个string中的单词
我试图从一个不同的string中使用自定义函数中出现在一个string中的单词。 例如：
A1：
那是为什么蓝色的帽子
A2：
陌生人想知道为什么他的蓝帽子变成了橙色
这个例子中的理想结果是：
A3：
陌生人想知道他的橙色
我需要打开引用中的单元格以便可以在不同情况下使用它们。 该函数将在一个单元格中使用，如下所示：
= WORDREMOVE（ “需要删除单词的单元格”，“要删除单词列表的单元格” ）
我有一个20000行的列表，并设法find一个自定义函数，可以删除重复的单词（下面），并认为可能有一种方法来操纵它来完成这项任务。
Function REMOVEDUPEWORDS(txt As String, Optional delim As String = " ") As String Dim x 'Updateby20140924 With CreateObject("Scripting.Dictionary") .CompareMode = vbTextCompare For Each x In Split(txt, delim) If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing Next If .Count > 0 Then REMOVEDUPEWORDS = Join(.keys, delim) End With End Function 如果你可以保证你在两个string中的单词将被空格分隔（不包括逗号，省略号等），那么你可以Split()两个string，然后Filter()输出单词：
Function WORDREMOVE(ByVal strText As String, strRemove As String) As String Dim a, w a = Split(strText) ' Start with all words in an array For Each w In Split(strRemove) a = Filter(a, w, False, vbTextCompare) ' Remove every word found Next WORDREMOVE = Join(a, " ") ' Recreate the string End Function
您也可以使用VBA中的正则expression式来执行此操作。 下面的版本不区分大小写，并且假定所有的单词都是由space分隔的。 如果还有其他的标点符号，更多的例子将有助于制定一个合适的解决scheme：
Option Explicit Function WordRemove(Str As String, RemoveWords As String) As String Dim RE As Object Set RE = CreateObject("vbscript.regexp") With RE .ignorecase = True .Global = True .Pattern = "(?:" & Join(Split(WorksheetFunction.Trim(RemoveWords)), "|") & ")\s*" WordRemove = .Replace(Str, "") End With End Function
我的例子当然不是最好的代码，但它应该工作
Function WORDREMOVE(FirstCell As String, SecondCell As String) Dim FirstArgument As Variant, SecondArgument As Variant Dim FirstArgumentCounter As Integer, SecondArgumentCounter As Integer Dim Checker As Boolean WORDREMOVE = "" FirstArgument = Split(FirstCell, " ") SecondArgument = Split(SecondCell, " ") For SecondArgumentCounter = 0 To UBound(SecondArgument) Checker = False For FirstArgumentCounter = 0 To UBound(FirstArgument) If SecondArgument(SecondArgumentCounter) = FirstArgument(FirstArgumentCounter) Then Checker = True End If Next FirstArgumentCounter If Checker = False Then WORDREMOVE = WORDREMOVE & SecondArgument(SecondArgumentCounter) & " " Next SecondArgumentCounter WORDREMOVE = Left(WORDREMOVE, Len(WORDREMOVE) - 1) End Function