在 excel 上使用 VBA 從單元格中洗掉重復的字串（整個單詞），但保留重復項的最后一個實體。
示例 hello hi world hello => hi world hello this is hello my hello world => 這是我的 hello world
我最初是一名 python 開發人員，所以請原諒我在 VBA 中缺乏語法，我編輯了一段在線找到的代碼，其邏輯如下：
''' Function RemoveDupeWordsEnd(text As String, Optional delimiter As String = " ") As String Dim dictionary As Object Dim x, part, endword
Set dictionary = CreateObject("Scripting.Dictionary")
dictionary.CompareMode = vbTextCompare
For Each x In Split(text, delimiter)
part = Trim(x)
If part <> "" And Not dictionary.exists(part) Then
dictionary.Add part, Nothing
End If
'' COMMENT
'' if the word exists in dictionary remove previous instance and add the latest instance
If part <> "" And dictionary.exists(part) Then
dictionary.Del part, Nothing
endword = part
dictionary.Add endword, Nothing
End If
Next
If dictionary.Count > 0 Then
RemoveDupeWordsEnd = Join(dictionary.keys, delimiter)
Else
RemoveDupeWordsEnd = ""
End If
Set dictionary = Nothing
結束功能
'''
感謝所有幫助和指導，將不勝感激
uj5u.com熱心網友回復：
保留匹配子串的最后一次出現
Option Explicit
Function RemoveDupeWordsEnd( _
ByVal DupeString As String, _
Optional ByVal Delimiter As String = " ") _
As String
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Item As Variant
Dim Word As String
For Each Item In Split(DupeString, Delimiter)
Word = Trim(Item)
If Len(Word) > 0 Then
If dict.Exists(Word) Then
dict.Remove Word
End If
dict(Word) = Empty ' the same as 'dict.Add Word, Empty'
End If
Next Item
If dict.Count > 0 Then RemoveDupeWordsEnd = Join(dict.Keys, Delimiter)
End Function
uj5u.com熱心網友回復：
在 while 回圈中使用 VBA 的替換，當字串的出現次數低于 2 時終止。替換采用可選引數表示要替換的匹配數。
Function keepLast(raw As String, r As String) As String
While (Len(raw) - Len(Replace(raw, r, ""))) / Len(r) > 1
raw = Replace(raw, r, "", , 1)
Wend
keepLast = Trim(Replace(raw, " ", " "))
End Function
我使用修剪并用單個空格替換任何雙空格來避免洗掉目標字串留下的無關空格。您可以通過僅計算出現次數并直接傳遞負 1 來替換來避免回圈：
Function keepLast(raw As String, r As String) As String
keepLast = raw
Dim cnt As Integer
cnt = (Len(raw) - Len(Replace(raw, r, ""))) / Len(r)
If cnt < 2 Then Exit Function
raw = Replace(raw, r, "", , cnt - 1)
keepLast = Trim(Replace(raw, " ", " "))
End Function
請記住，這種方法很容易受到部分匹配的影響。如果您的原始字串是“hello that Othello is a good play hello there”，那么您最終會得到“that O is a good play hello there”，我不認為這正是您想要的。如果有必要，您可以使用正則運算式來解決這個問題：
Function keepLast(raw As String, r As String) As String
Dim parser As Object
Set parser = CreateObject("vbscript.regexp")
parser.Global = True
parser.Pattern = "\b" & r & "\b"
While parser.Execute(raw).Count > 1
raw = parser.Replace(raw, "")
Wend
keepLast = Trim(Replace(raw, " ", " "))
End Function
如果您需要處理“hello”和“Hello”，regexp 物件具有忽略大小寫的屬性。你可以這樣設定：
parser.ignoreCase = true
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/429218.html