搜索和替换不仅可以用空格分隔的整个单词

Posted 2023-03-11

【中文标题】搜索和替换不仅可以用空格分隔的整个单词

【英文标题】：Search and replace whole words which can be separated not only by a space

【发布时间】：2012-07-28 13:07:45

【问题描述】：

我正在寻找一种方法来搜索和替换整个单词。整个单词不仅可以用空格分隔，还可以用 .,;:/?等等

我想做这样的事情

replace([address], ***--list of separators, like .,;:/?--*** & [replacewhat] & ***--list of separators, like .,;:/?--*** ," " & [replacewith] & " ")

我不知道如何传递分隔符列表，而不是为每个分隔符组合运行一次替换函数（加上我要替换的 300 个单词，这将构成疯狂的查询数量）。

【问题讨论】：

问题是你不能定义它运行的规则。有太多的变化/排列。因此，没有任何一套逻辑可以做到这一点。您可以期望的最好的结果是一个可以标记需要人工审查的过程；检查您要更新的那些，然后在手动审查后让系统更新。否则，您将开发一个 AI 来处理排列。

这不是真的，首先，MS 已经做到了（你可以搜索整个单词），其次，我可以想出一个组合列表，然后运行我的 300 个单词中的每一个每一套。我真的很想避免这种情况，但这是 100% 可能的。我可以做的另一件事是运行替换，它将所有字符替换为空格，然后替换我的 300 个单词（如果它们被空格包围）。所以有很多方法可以做到，我只是想找到最好的方法。我必须相信有办法搜索整个单词。谢谢！！

我已经有了代码，可以为我提供 9 以下任意数字中的 2 的所有排列。我只是想避免那样做。

【参考方案1】：

感谢您的回答。这对我帮助很大。

但是，由于我的数据量增加，这段代码的迭代次数增加了，我意识到这段代码正在减慢我的应用程序的速度。例如，此代码的 10,000 次迭代大约需要 20 秒。

我根据您的回答使用了以下代码：

Function CleanString(ByVal InputString As String, Optional SplWords = "USP|BP|EP|IP|JP", _
                Optional Delim As String = "|") As String
Dim i As Integer
Dim ArrIsEmpty As Boolean
Dim ArrSplWords() As String
Dim Wrd As Variant
Dim RE As Object

CleanString = InputString
ArrSplWords = Split(SplWords, Delim)

Set RE = CreateObject("VBScript.RegExp")
RE.Global = True
RE.ignorecase = True
For Each Wrd In ArrSplWords
    RE.Pattern = "\b" & Wrd & "\b"
    If RE.test(CleanString) Then
        CleanString = RE.Replace(CleanString, "")
    End If
Next Wrd
CleanString = Application.WorksheetFunction.Trim(CleanString)
End Function

为了解决缓慢的问题，我决定放弃 RegExp 方法并提出以下代码。根据我的评估，下面的函数大约快 25 倍（我使用计时器函数对每个代码进行了 1000 次迭代）。

Function CleanString(ByVal InputString As String, Optional SplWords As String = "USP|BP|EP|IP|JP", _
                Optional Delim As String = "|", Optional WordSeparator As String = " ", _
                Optional SplChar As String = "~|`|!|@|#|$|%|^|&|*|-|+|=|'|<|>|,|.|/|\|?|:|;") As String
Dim TestStr As String
Dim ArrSplChar() As String
Dim Char As Variant
Dim TestWords() As String
Dim Wrd As Variant
Dim Counter As Integer

TestStr = InputString
ArrSplChar = Split(SplChar, Delim, -1, vbTextCompare)

For Each Char In ArrSplChar
    TestStr = Replace(TestStr, Char, WordSeparator & Char & WordSeparator, 1, -1, vbTextCompare)
Next Char

TestWords = Split(TestStr, WordSeparator, -1, vbTextCompare)

For Each Wrd In TestWords
    Counter = IIf(Wrd = "", Counter + 1, Counter)
    If InStr(1, LCase(SplWords), LCase(Wrd), vbTextCompare) = 0 Then
        CleanString = CleanString & " " & Wrd
        Counter = Counter + 1
    End If
Next Wrd
CleanString = IIf(Counter - 1 = UBound(TestWords) - LBound(TestWords), _
                        Application.WorksheetFunction.Trim(InputString), _
                        Application.WorksheetFunction.Trim(CleanString))
End Function

这个函数看起来比基于 regExp 的函数有点乱，但比基于 regExp 的函数快。

上述两个函数产生相同的输出，可以如下调用：

Sub TestSub()
Debug.Print CleanString("Paracetamol USP")
End Sub

这将在即时窗口中打印“扑热息痛”。

【参考方案2】：

您可以在要替换的单词前后使用带有\b 标记（用于单词边界）的模式使用正则表达式进行替换。

Public Function RegExpReplaceWord(ByVal strSource As String, _
    ByVal strFind As String, _
    ByVal strReplace As String) As String
' Purpose   : replace [strFind] with [strReplace] in [strSource]
' Comment   : [strFind] can be plain text or a regexp pattern;
'             all occurences of [strFind] are replaced
    ' early binding requires reference to Microsoft VBScript
    ' Regular Expressions:
    'Dim re As RegExp
    'Set re = New RegExp
    ' with late binding, no reference needed:
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")

    re.Global = True
    're.IgnoreCase = True ' <-- case insensitve
    re.pattern = "\b" & strFind & "\b"
    RegExpReplaceWord = re.Replace(strSource, strReplace)
    Set re = Nothing
End Function

正如所写，搜索区分大小写。如果您想不区分大小写，请启用此行：

re.IgnoreCase = True

在即时窗口中...

? RegExpReplaceWord("one too three", "too", "two")
one two three
? RegExpReplaceWord("one tool three", "too", "two")
one tool three
? RegExpReplaceWord("one too() three", "too", "two")
one two() three
? RegExpReplaceWord("one too three", "to", "two")
one too three
? RegExpReplaceWord("one too three", "t..", "two")
one two three

...以及您的分隔符范围...

? RegExpReplaceWord("one.too.three", "too", "two")
one.two.three
? RegExpReplaceWord("one,too,three", "too", "two")
one,two,three
? RegExpReplaceWord("one;too;three", "too", "two")
one;two;three
? RegExpReplaceWord("one:too:three", "too", "two")
one:two:three
? RegExpReplaceWord("one/too/three", "too", "two")
one/two/three
? RegExpReplaceWord("one?too?three", "too", "two")
one?two?three
? RegExpReplaceWord("one--too--three", "too", "two")
one--two--three
? RegExpReplaceWord("one***too***three", "too", "two")
one***two***three

【讨论】：

我做错了吗？我在查询 Expr2: RegExpReplaceWord([newaddress1],"st","street") 中使用它，它没有替换。 NewAddress1 Expr2 1 COLUMBIA ST 1 COLUMBIA ST

哦，它区分大小写，没问题，这太优雅了！！）））））））

您只能接受一个答案。我建议你选择最适合你的那个。您还可以投票支持您认为有用的所有答案。我可以投票。而且，是的，我记得你在前面的问题中被我的Case Else 逗乐了；它让我崩溃了。

@Remou，对不起，我不知道发生了什么。我不接受答案并支持您并试图回复您，但您的帖子完全消失了。我不知道我只能标记一个答案。您的解决方案非常有趣，但如果我必须选择 - 我会选择 vba 和 vbs。对不起，谢谢你

嘿，HansUp，我希望你不介意，我在 Access-Programmers.co.uk 上发布了你的解决方案（给你信用），我在 2 年前就有一个关于这个的帖子））））），我在这里链接回来。线程在这里access-programmers.co.uk/forums/…