【问题标题】:Best way to create a blacklist in vba?在 vba 中创建黑名单的最佳方法?
【发布时间】:2021-07-27 05:05:02
【问题描述】:

我正在尝试创建一个排除一些项目的数组列表。

示例:列表 a 包含 {a,b,c,d,e,f,g} 黑名单包含 {a,c,e} 我希望我的新列表只有 {b,d,f,g}

这是我迄今为止尝试过的。

Dim a As Object
Set a = CreateObject("System.Collections.ArrayList")

Dim blacklist As Object
Set blacklist = CreateObject("System.Collections.ArrayList")

Dim newList As Object
Set newList = CreateObject("System.Collections.ArrayList")

a.Add "a"
a.Add "b"
a.Add "c"
a.Add "d"
a.Add "e"
a.Add "f"
a.Add "g"


blacklist.Add "a"
blacklist.Add "c"
blacklist.Add "e"


For Each c In a
    For Each b In blacklist
      If c.value <> b Then newList.Add c.value
    Next b
Next c

它不起作用并从数组列表中打印两次

【问题讨论】:

  • 只有外循环和If not blacklist.contains(c) then newList.Add c.value
  • 谢谢,它有效!

标签: arrays vba arraylist range


【解决方案1】:

首先,c.value 需要替换为c。现在代码运行但出错了,因为它只会多次添加每个字母,最终会出现重复。

你需要替换这个:

For Each c In a
    For Each b In blacklist
      If c.value <> b Then newList.Add c.value
    Next b
Next c

用这个:

For Each c In a
    found = False
    For Each b In blacklist
        If c = b Then
            found = True
            Exit For
        End If
    Next b
    If Not found Then newList.Add c
Next c

并且代码将按预期运行。

当然,@ScottCraner 在 cmets 部分提供的解决方案更优雅,您应该使用它。在下文中,我将讨论您的代码的其他方面以及实现相同结果的其他方法。

您应该打开Option Explicit,以便编译器始终强制您声明变量。在您的代码中,bc 变量均未声明。它们应该是Variant 类型,因为您在For Each 循环中使用它们,但实际上它们将具有String 值。比如:

Option Explicit

Sub Test()
    Dim a As Object
    
    Set a = CreateObject("System.Collections.ArrayList")
    
    Dim blacklist As Object
    Set blacklist = CreateObject("System.Collections.ArrayList")
    
    Dim newList As Object
    Set newList = CreateObject("System.Collections.ArrayList")
    
    a.Add "a"
    a.Add "b"
    a.Add "c"
    a.Add "d"
    a.Add "e"
    a.Add "f"
    a.Add "g"
    
    blacklist.Add "a"
    blacklist.Add "c"
    blacklist.Add "e"
    
    Dim c As Variant
    Dim b As Variant
    Dim found As Boolean
    
    For Each c In a
        found = False
        For Each b In blacklist
            If c = b Then
                found = True
                Exit For
            End If
        Next b
        If Not found Then newList.Add c
    Next c
End Sub

您应该为变量命名,以便它们传达更多信息。 abc 对代码的读者/维护者没有任何意义。您已经使用blacklist 正确完成了它,所以只需应用相同的约定。此外,我会使用 camelCase 使代码更易于阅读(就像您使用 newList 所做的那样)。比如:

Option Explicit

Sub Test()
    Dim originalList As Object
    Dim blackList As Object
    Dim newList As Object
    
    Set originalList = CreateObject("System.Collections.ArrayList")
    Set blackList = CreateObject("System.Collections.ArrayList")
    Set newList = CreateObject("System.Collections.ArrayList")
    
    originalList.Add "a"
    originalList.Add "b"
    originalList.Add "c"
    originalList.Add "d"
    originalList.Add "e"
    originalList.Add "f"
    originalList.Add "g"
    
    blackList.Add "a"
    blackList.Add "c"
    blackList.Add "e"
    
    Dim originalItem As Variant
    Dim blackListedItem As Variant
    Dim foundItem As Boolean
    
    For Each originalItem In originalList
        foundItem = False
        For Each blackListedItem In blackList
            If originalItem = blackListedItem Then
                foundItem = True
                Exit For
            End If
        Next blackListedItem
        If Not foundItem Then newList.Add originalItem
    Next originalItem
End Sub

我不知道你是否真的需要使用ArrayList 对象。您可以使用数组和Collection 对象获得相同的结果。使用集合的键散列也比遍历项目更有效(我指的是第二个 For 循环)。比如:

Option Explicit

Sub Test()
    Dim originalList() As Variant
    Dim blackList As Collection
    Dim newList As Collection

    originalList = Array("a", "b", "c", "d", "e", "f", "g")
    Set blackList = New Collection
    With blackList
        .Add Empty, "a" 'Note we only need the key
        .Add Empty, "c"
        .Add Empty, "e"
    End With
    Set newList = New Collection

    Dim originalItem As Variant
    
    On Error Resume Next 'In case key already exists
    For Each originalItem In originalList
        blackList.Item CStr(originalItem) 'Check if key exists
        If Err.Number <> 0 Then
            newList.Add originalItem
            Err.Clear
        End If
    Next originalItem
    On Error GoTo 0
End Sub

最后,您可以使用我不久前构建的array library。您需要导入 LibArrayTools.bas 模块,然后执行以下操作:

Option Explicit

Sub Test()
    Dim originalList() As Variant
    Dim blackList() As Variant
    Dim newList() As Variant
    
    originalList = Array("a", "b", "c", "d", "e", "f", "g")
    blackList = Array("a", "c", "e")
    newList = Filter1DArray(originalList, CreateFiltersArray("NOT IN", blackList))
End Sub

【讨论】:

    猜你喜欢
    • 2011-03-20
    • 1970-01-01
    • 1970-01-01
    • 2012-08-30
    • 2013-08-07
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多