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

输出：

word2 word4
word2 word4
True

可以从WorkSheet的专栏填写字典。

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

2 个答案: