从单元格中删除不在列表中的单词

如何解决从单元格中删除不在列表中的单词

我想从Excel列表中删除不在单独列表中的某些单词。 有人用“查找/替换”给我提供了一个示例，但我需要完全相反的意思，这意味着我想将单词保留在列表中并删除其他单词。另外，如果删除一个单词，我将有1个以上的空格，因此我需要删除多个空格。 谁能给我一个例子吗？ 谢谢， 塞巴斯蒂安 编辑 初始单元格内容：

word1 word2 word3 word4

脚本后的单元格内容：

word2 word4

我的清单包含：

word2,word4,word7,...

    

解决方法

        这有效：

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

    ,        使用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

输出：

word2 word4
word2 word4
True

该词典可以从WorkSheet的列中填写。