Question

就像我的标题一样，我试图基于另一个数组从VBA数组中过滤出特定的字符串。

我的代码看起来像这样：

For Each item In exclusions_list
    updated_list = Filter(updated_list, item, False, vbTextCompare)
Next item

我的问题是我只想排除完全匹配，而我似乎找不到找到解决办法。

如果我在exclusions_list中有“如何”，我想从“ updated_list”中排除“如何”，但没有“ however”。

我很抱歉，如果以前曾问过这个问题。我找不到明确的答案，而且我对VBA不太熟悉。

谢谢！

Answer 1

Filter方法仅查找子字符串。它无法识别整个单词。

做到这一点的一种方法是使用Regular Expressions，它包括一个识别单词边界的令牌。仅在您正在考虑的子字符串不包含非Word字符的情况下才有效。单词字符是[A-Za-z0-9_]中的字符（非英语语言除外）。

例如：

Option Explicit
Sub foo()
    Dim arr
    Dim arrRes
    Dim V
    Const sfilter As String = "gi"
    Dim col As Collection

arr = Array("Filter", "by", "bynomore", "gi", "gif")

Dim re As Object, MC As Object, I As Long
Set col = New Collection
Set re = CreateObject("vbscript.regexp")
    With re
        .ignorecase = True
        .Pattern = "\b" & sfilter & "\b"
        For I = 0 To UBound(arr)
            If .test(arr(I)) = False Then _
                col.Add arr(I)
        Next I
    End With
ReDim arrRes(0 To col.Count - 1)
    For I = 1 To col.Count
        arrRes(I - 1) = col(I)
    Next I
End Sub

结果数组arrRes将包含gif但不包含gi

Answer 2

添加对RegEx的引用：

Option Explicit
Sub Filter()
    Dim words() As String
    words = Split("how,however,test3,test4,,,howevermore,how,whatsohowever,test1,test2", ",")
    Dim regex As New RegExp
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = "^how$" ' ^ means must start with and $ means must end with
    End With
    Dim i As Integer
    For i = 0 To UBound(words)
        If regex.Test(words(i)) Then
            ' Debug.Print words(i) + " is an exact match!"
            words(i) = vbNullString  ' Just clear out item, skip later.
        Else
            ' Debug.Print words(i) + " is NOT  a match!"
        End If
    Next i

    For i = 0 To UBound(words)
        If (StrPtr(words(i)) <> 0) Then ' We can use this to explicitly catch vbNullString, because "" has a pointer. 
          Debug.Print words(i)
        End If
    Next i

End Sub

Answer 3

通过非常简单的Replace函数进行处理

除了上面的有效解决方案之外，还只是为了演示使用简单的Replace函数的另一种方法。 该解决方案并不伪装成执行排除的最有效方法。

示例代码

Sub Howdy()
' Purpose: exclude exactly matching array items (not case sensitive)
  Dim exclusions_list, updated_list, item
  exclusions_list = Array("How", "much")
' assign test list (with successive repetitions)
  updated_list = Split("Bla bla,How,how,Howdy,However,How,much,much,much,Much,Much,How much,something else", ",")
  ' Debug.Print UBound(updated_list) + 1 & " items in original list: """ & Join(updated_list, "|") & """"
' execute exclusions
  For Each item In exclusions_list
      updated_list = modifyArr(updated_list, item)   ' call helper function modifyArr()
      ' Debug.Print UBound(updated_list) + 1 & " items excluding """ & item & """:" & vbTab & """" & _
                    Join(updated_list, "|") & """"
  Next item
End Sub

注意

不加注释 Debug.Print语句，您将在VBE立即窗口中获得以下结果：

13 items in original list:  "Bla bla|How|how|Howdy|However|How|much|much|much|Much|Much|How much|something else"
10 items excluding "How":   "Bla bla|Howdy|However|much|much|much|Much|Much|How much|something else"
5 items excluding "much":   "Bla bla|Howdy|However|How much|something else"

辅助功能modifyArr()

请注意，有必要排除字符串的连续重复，因为单个Replace语句不会取代所有要替换的字符串随后的字符串部分。

Function modifyArr(ByVal arr, ByVal item) As Variant
  Const C = ",": Dim temp$, sLen$
  temp = Replace(C & Join(arr, C) & C, C & item & C, Replace:=C, Compare:=vbTextCompare)
  Do While True             ' needed to get successive repetitions !
      sLen = Len(temp)
      temp = Replace(temp, C & item & C, Replace:=C, Compare:=vbTextCompare)
      If sLen = Len(temp) Then Exit Do
  Loop
' return
  modifyArr = Split(Mid$(temp, 2, Len(temp) - 2), C)
End Function

Answer 4

最初，我不清楚人们为什么要在这里使用 RegExp。 OP 要求按文字字符串匹配进行过滤。 RegExp 用于将文本模式与变量匹配。当然，它也可以用于没有变量的模式，但如果模式没有变量，这里没有，RegExp 不添加任何东西。

基本循环

执行此操作的最基本方法（基于先前的答案但不使用 RegExp）是遍历数组：

Sub ShowFilterOutExact()
    startingArray = Array("Filter", "by", "bynomore", "gi", "gif")
    filteredArray = FilterOutExact("gif", startingArray)
End Sub

Function FilterOutExact(exactValue, sourceArray)
    Set tempCollection = New Collection
    For i = 0 To UBound(sourceArray)
        If sourceArray(I) <> exactValue Then tempCollection.Add sourceArray(i)
    Next
    ReDim returnArray(0 To col.Count - 1)
    For i = 1 To tempCollection.Count
        returnArray(i - 1) = col(i)
    Next
    FilterOutExact = returnArray
End Function

这只是遍历数组并检查每个值是否等于不需要的值。如果没有，则将其添加到 tempCollection。然后将 tempCollection 转换为数组。使用 tempCollection 的原因是，将项目以迭代方式添加到集合中通常比添加到数组中更容易、更快。

替换和过滤

对于另一个可能更快的想法，您还可以做一些解决方法来仍然使用内置的 Filter() 函数。以下函数首先用指定的 DumpValue 替换任何不匹配项，然后使用 Filter() 删除包含此 DumpValue 的任何行。

Function FilterExactMatch(SourceArray, Match, DumpValue)
    For i = LBound(SourceArray) To UBound(SourceArray)
        If SourceArray(i) <> Match Then SourceArray(i) = DumpValue
    Next
    FilterExactMatch = Filter(SourceArray, DumpValue, False)
End Function

如果您想要来自 Filter() 的 Include 参数，它可以让您删除匹配项而不是保留它们：

Function FilterExactMatch(SourceArray, Match, DumpValue, Optional Include = True)  
    For i = LBound(SourceArray) To UBound(SourceArray)
        ExactMatch = SourceArray(i) = Match
        If ExactMatch Xor Include Then SourceArray(i) = DumpValue
    Next
    FilterExactMatch = Filter(SourceArray, DumpValue, False)
End Function

一次过滤掉多个值

最后，这是另一种一次过滤出多个精确值的方法。这将使用 Application.Match 函数，它会根据一组值检查一组值。我没有检查这是否比嵌套循环更快，但我认为这是 Application.Match 的一个有趣功能。

Function FilterOutMultiple(unwantedValuesArray, sourceArray)
    If LBound(sourceArray) <> 0 Then
        MsgBox "sourceArray argument must be zero-based for this to work as written"
        Exit Function
    End If
    matchArray = Application.Match(sourceArray, unwantedValuesArray, 0)
    matchCount = Application.Count(matchArray)
    ReDim returnArray(UBound(sourceArray) - matchCount)
    j = -1
    For i = 0 To UBound(sourceArray)
        If IsError(matchArray(i + 1)) Then
            j = j + 1
            returnArray(j) = sourceArray(i)
        End If
    Next
    FilterOutMultiple = returnArray
End Function

VBA /如何过滤精确字符串上的数组？

4 个答案: