搜索并替换整个单词,这些单词不仅可以通过空格分隔。

3
我想寻找一种可以搜索和替换整个单词的方法。这些整个单词不仅可以由空格分隔,还可以由 .,;:/? 等符号分隔。
我希望实现类似于以下的操作:
replace([address], ***--list of separators, like .,;:/?--*** & [replacewhat] & ***--list of separators, like .,;:/?--*** ," " & [replacewith] & " ")

我不知道该如何传递一个分隔符列表,而不是为每个分隔符组合运行一次替换函数(如果与我要替换的300个单词相结合,将会产生大量查询)。


问题在于您无法定义其操作规则。变数/排列组合太多了。因此,没有一套逻辑可以正确处理它。您最好的希望是一个流程,用于标记需要人工审核的内容;检查您想更新的内容,然后在手动审核后让系统进行更新。否则,您将不得不开发AI来处理这些排列组合。 - xQbert
2
这不是完全正确的,首先微软已经做到了(可以搜索整个单词),其次,我可以列出一系列组合,然后将我的300个单词与每个集合一起运行。我真的想避免这样做,但这是100%可能的。我还可以运行一个替换程序,将所有字符替换为空格,如果我的300个单词被空格包围,则替换它们。因此有多种方法可以实现,我只是试图找到最好的方法。我相信有寻找整个单词的方法。谢谢! - lalachka
我已经有代码可以给我所有小于9的任意数字的2个排列。我只是真的想避免那种方式。 - lalachka
2个回答

14

您可以使用正则表达式中带有\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

我没想到要警告你区分大小写的问题;我更新了答案。 - HansUp
1
你只能接受一个答案。我建议你选择最适合你的那个。你也可以给你觉得有用的所有答案点赞。我很满意投票。是的,我记得你对我在之前的问题中使用 Case Else 很感兴趣;那真的很有趣。 - HansUp
顺便问一下,你想从这里得到什么?RegExpReplaceWord("ST JAMES INFIRMARY", "ST", "STREET") - HansUp
1
@Remou,非常抱歉,我不知道发生了什么事情。我取消了答案的采纳并给你点赞,试图回复你,但是你的帖子完全消失了。我不知道我只能标记一个答案。你的解决方案非常有趣,但如果我必须选择,我会选择VBA和VBS。对不起,谢谢。 - lalachka
1
嘿,HansUp,希望你不介意,我在Access-Programmers.co.uk上发布了你的解决方案(并给予你信用),我在那里有一个2年前开始的帖子)))),并且我链接回这里。该帖子在此处http://www.access-programmers.co.uk/forums/showpost.php?p=1177736&postcount=13 - lalachka
显示剩余6条评论

0

感谢您的回答,对我非常有帮助。

然而,随着我的数据量增加,这段代码的迭代次数也增加了,我意识到这段代码正在拖慢我的应用程序。例如,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

这将在立即窗口中打印“Paracetamol”。


网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接