Искать и заменять ТОЛЬКО ВСЕ СЛОВА

Я ищу способ поиска и замены ТОЛЬКО СЛОВ. Поскольку все слова в моем случае могут быть разделены не только пробелом, но.,;:/? и т.д. Я не могу придумать эффективный способ кодирования этого.

В основном, я хочу сделать что-то вроде этого

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

Я не знаю, как передать список разделителей сразу, вместо этого запускать функцию замены один раз для каждой КОМБИНАЦИИ разделителей (что в сочетании с 300 словами, которые я заменяю, приведет к безумному количеству запросов)

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

Спасибо за ваш ответ. Это очень помогло мне.

Однако по мере увеличения количества итераций этого кода из-за увеличения размера моих данных я понял, что этот фрагмент кода замедляет работу моего приложения. Например, 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

Это напечатает «Парацетамол» в ближайшем окне.

Другие вопросы по тегам