在 vba 中创建黑名单的最佳方式?
Best way to create a blacklist in vba?
我正在尝试创建一个排除一些项目的数组列表。
示例:列表 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
它不起作用并打印数组列表中的项目两次
首先,需要将c.value
替换为c
。现在代码 运行s 是错误的,因为它会简单地多次添加每个字母,你最终会得到重复项。
你需要替换这个:
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在评论区提供的解决方案更优雅,你应该使用它。在下文中,我将介绍您的代码的其他方面以及实现相同结果的其他方法。
您应该打开 Option Explicit
,以便编译器始终强制您声明变量。在您的代码中, b
和 c
变量都没有声明。它们应该是 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
您应该为变量命名,以便它们传达更多信息。 a
、b
、c
对代码的 reader/maintainer 没有任何意义。您已经使用 blacklist
正确完成了它,因此只需应用相同的约定即可。另外,我会使用驼峰命名法使代码更易于阅读(就像您使用 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
我正在尝试创建一个排除一些项目的数组列表。
示例:列表 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
它不起作用并打印数组列表中的项目两次
首先,需要将c.value
替换为c
。现在代码 运行s 是错误的,因为它会简单地多次添加每个字母,你最终会得到重复项。
你需要替换这个:
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在评论区提供的解决方案更优雅,你应该使用它。在下文中,我将介绍您的代码的其他方面以及实现相同结果的其他方法。
您应该打开 Option Explicit
,以便编译器始终强制您声明变量。在您的代码中, b
和 c
变量都没有声明。它们应该是 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
您应该为变量命名,以便它们传达更多信息。 a
、b
、c
对代码的 reader/maintainer 没有任何意义。您已经使用 blacklist
正确完成了它,因此只需应用相同的约定即可。另外,我会使用驼峰命名法使代码更易于阅读(就像您使用 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