您可以使用带有\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
谢谢您的回答。这对我有很大帮助。
然而，由于我的数据量增加，这段代码的迭代次数增加了，我意识到这段代码正在减慢我的应用程序的速度。例如，此代码的 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
这将在即时窗口中打印“扑热息痛”。