Question

我正在尝试使用自定义函数从不同的字符串中删除出现在一个字符串中的单词。例如：

A1：

这就是蓝帽的原因

A2：

陌生人想知道为什么他的蓝帽子变成了橙色

这个例子的理想结果是：
A3：

陌生人想知道他变成了橙色

我需要让参考中的单元格打开以进行更改，以便它们可以在不同的情况下使用。该函数将在单元格中用作：

= WORDREMOVE（＆＃34;单词需要删除＆＃34;，＆＃34;单元格列表被删除＆＃34; ）

我有一个20,000行的列表，并设法找到一个可以删除重复单词的自定义函数（下面），并认为可能有办法操纵它来完成此任务。

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

Answer 1

如果你可以保证两个字符串中的单词都用空格分隔（没有逗号，省略号等），你可以Split()两个字符串然后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

Answer 2

您也可以使用VBA中的正则表达式执行此操作。以下版本不区分大小写，并假设所有单词仅由space分隔。如果还有其他标点符号，更多示例将有助于制定适当的解决方案：

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

Answer 3

我的例子肯定不是最好的代码，但它应该可行

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

Excel VBA自定义函数从另一个字符串中删除出现在一个字符串中的单词

3 个答案: