從單元格中刪除不在列表中的單詞

Question

我想從 excel 列表中刪除一些不在單獨列表中的單詞。 有人給了我一個查找/替換的例子，但我需要完全相反，這意味着我想保留列表中的單詞並刪除其他單詞。 此外，如果刪除了一個單詞，我將有超過 1 個空格，所以我需要刪除多個空格。

誰能給我一個例子？

謝謝，塞巴斯蒂安

編輯

初始單元格內容： word1 word2 word3 word4

腳本后的單元格內容： word2 word4

我的列表包含： word2, word4, word7, ...

Answer 1

這有效：

Sub words()
    Dim whitelist() As Variant
    Dim listToScreen As Variant
    Dim screenedList As String
    Dim itsInTheWhitelist As Boolean
    Dim i As Long
    Dim j As Long

    ' Words to keep
    whitelist = Array("word2", "word4", "word7")

    ' Input old cell contents, split into array using space delimiter
    listToScreen = Split(Range("A1").Value, " ")

    screenedList = ""
    For i = LBound(listToScreen) To UBound(listToScreen)

        ' Is the current word in the whitelist?
        itsInTheWhitelist = False
        For j = LBound(whitelist) To UBound(whitelist)
            If listToScreen(i) = whitelist(j) Then
                itsInTheWhitelist = True
                Exit For
            End If
        Next j

        If itsInTheWhitelist = True Then
            ' Add it to the screened list, with space delimiter if required
            If Not screenedList = "" Then
                screenedList = screenedList & " "
            End If
            screenedList = screenedList & listToScreen(i)
        End If
    Next i

    'Output new cell contents
    Range("A2").Value = screenedList

End Sub

Answer 2

使用 Scripting.Dictionary 和 RegExp 將花費兩個引用，但會避免 N*N 循環：

' needs ref to Microsoft Scripting Runtime,
' Microsoft VBScript Regular Expressions 5.5

Option Explicit

Sub frsAttempt()
  Dim sInp As String: sInp = "word1 word2 word3 word4"
  Dim aInp As Variant: aInp = Split(sInp)
  Dim sExp As String: sExp = "word2 word4"
  Dim sLst As String: sLst = "word2, word4, word7"
  Dim aLst As Variant: aLst = Split(sLst, ", ")
  Dim dicGoodWords As New Dictionary
  Dim nIdx
  For nIdx = 0 To UBound(aLst)
    dicGoodWords(aLst(nIdx)) = 0
  Next
  For nIdx = 0 To UBound(aInp)
      If Not dicGoodWords.Exists(aInp(nIdx)) Then
         aInp(nIdx) = ""
      End If
  Next
  Dim sRes As String: sRes = Join(aInp)
  Dim reCleanWS As New RegExp
  reCleanWS.Global = True
  reCleanWS.Pattern = "\s+"
  sRes = Trim(reCleanWS.Replace(sRes, " "))
  Debug.Print sExp
  Debug.Print sRes
  Debug.Print sRes = sExp
End Sub

Output：

word2 word4
word2 word4
True

字典可以從 WorkSheet 的列中填充。