我正在尝试找出从列表中踢出不需要的项目的任何方法。例如,我希望从列表中删除47
和90
,因为它们不符合条件。我在脚本中使用了Delete
,这绝对不是正确的关键字。但是,请将其视为占位符。
我尝试过:
Sub DeleteItemConditionally()
Dim numList As Variant, elem As Variant
numList = Array("12", "47", "90", "15", "37")
Debug.Print UBound(numList) - LBound(numList) + 1
For Each elem In numList
If elem >= 40 Then
Delete elem
End If
Next elem
Debug.Print UBound(numList) - LBound(numList) + 1
End Sub
预期结果:
First print : 5 (already getting it)
Second print: 3 (want to achieve it)
答案 0 :(得分:1)
向数组添加和删除其他元素相当慢。用Redim
更改数组的尺寸是VBA中最慢的操作之一。无论如何,如果我们要讨论的案件数量不多,那么速度就可以了:
Option Explicit
Sub DeleteItemConditionally()
Dim numList As Variant
numList = Array(12, 47, 90, 15, 3)
Dim newElements() As Variant
Dim firstElement As Boolean: firstElement = True
Dim i As Long
For i = LBound(numList) To UBound(numList)
If numList(i) <= 40 Then
If firstElement Then
ReDim Preserve newElements(0)
firstElement = False
Else
ReDim Preserve newElements(UBound(newElements) + 1)
End If
newElements(UBound(newElements)) = numList(i)
End If
Next
Dim element As Variant
For Each element In newElements
Debug.Print element
Next
End Sub
在使用Collection或System.Collections.ArrayList的情况下(如下所示),优化和速度会更快(但如果数据不超过几百个,则仍然看不见)。此外,可以对集合进行相当快速的排序,然后任务的速度会更快:
Sub TestMyCollection()
Dim myList As Object
Set myList = CreateObject("System.Collections.ArrayList")
With myList
.Add 12
.Add 47
.Add 90
.Add 15
.Add 3
End With
myList.Sort
Dim i As Long
For i = myList.Count - 1 To 0 Step -1
If Not myList.Item(i) <= 40 Then
myList.RemoveAt i
End If
Next i
Dim element As Variant
For Each element In myList
Debug.Print element
Next
End Sub
另外,为了提高性能并更好地使用第一个数字后的.Sort()
,可以退出大于For i = myList.Count - 1 To 0 Step -1
的40个数字。
答案 1 :(得分:1)
如果您使用单个维度数组表示列表,则将数组替换为集合(或者如果您希望更高级的Scripting.Dictionary)会更好。
如果将数组替换为集合,则基本上不需要对代码进行任何重大更改。只需进行一些细微调整即可弥补您无法查询集合以获取项索引的事实,因此在特定情况下,您必须按索引而不是按项进行迭代。
我已经更新了代码,添加了一个函数,该函数通过返回填充的Collection来替换Array方法,并更新了循环以使用索引。您还应该注意,索引循环递减计数。这是因为如果我们从集合中删除项目,则大小将不再是循环开始时获得的计数。
Sub DeleteItemConditionally()
Dim my_num_list As Collection, my_item_index As Long
Set my_num_list = FilledCollection("12", "47", "90", "15", "37")
Debug.Print my_num_list.Count
For my_item_index = my_num_list.Count To 1 Step -1
If my_num_list(my_item_index) >= 40 Then
my_num_list.Remove my_item_index
End If
Next
Debug.Print my_num_list.Count
End Sub
Public Function FilledCollection(ParamArray args() As Variant) As Collection
Dim my_return As Collection
Dim my_item As Variant
Set my_return = New Collection
For Each my_item In args
my_return.Add my_item
Next
Set FilledCollection = my_return
End Function
答案 2 :(得分:1)
注意:此答案集中于所问的问题:如何有条件地从Array中删除项目。其他答案涉及许多其他选择。
首先:您的数据。您已经创建了一个 String 数组,然后将它们与 Number 进行了比较。那是行不通的(好吧,它会给出答案,但是那不是您所期望的)。我已将您的数据更改为 Numbers
第二:我已经创建了Delete功能作为 Function ,该功能返回一个可能精简的数组。它仅接受一维数组(如果传递了其他任何东西,则返回此传递的结果)
第三:我从CPearson.Com借了一些效用函数-顺便说一句,这对于VBA来说是个很棒的资源
第四:我为测试类型(>=
或<
)提供了一些灵活性-如果需要,您可以添加更多内容。
最后:速度。是否足够快取决于您的用例。我已经对其进行了如下测试-数组大小为5,在3.9 mS中运行1000次。 10,000个阵列的大小是586毫秒的1000倍
Sub Test()
Dim numList As Variant
numList = Array(12, 47, 90, 15, 37)
Debug.Print UBound(numList) - LBound(numList) + 1
numList = DeleteItemConditionally(numList, 40)
Debug.Print UBound(numList) - LBound(numList) + 1
End Sub
Function DeleteItemConditionally(Arr As Variant, Optional DeleteGEQ As Variant, Optional DeleteLES As Variant) As Variant
Dim NewArr As Variant
Dim iArr As Long, iNewArr As Long
' Check if Arr is valid
If Not IsArrayAllocated(Arr) Then GoTo AbortExit
If NumberOfArrayDimensions(Arr) <> 1 Then GoTo AbortExit
' that one and only one of Delete criteria is specified
If Not (IsMissing(DeleteGEQ) Xor IsMissing(DeleteLES)) Then GoTo AbortExit
ReDim NewArr(LBound(Arr) To UBound(Arr))
If Not IsMissing(DeleteGEQ) Then
' Delete members >= DeleteGEQ
iNewArr = LBound(Arr) - 1
For iArr = LBound(Arr) To UBound(Arr)
If Arr(iArr) < DeleteGEQ Then
iNewArr = iNewArr + 1
NewArr(iNewArr) = Arr(iArr)
End If
Next
Else
' Delete members < DeleteGEQ
iNewArr = LBound(Arr) - 1
For iArr = LBound(Arr) To UBound(Arr)
If Arr(iArr) >= DeleteGEQ Then
iNewArr = iNewArr + 1
NewArr(iNewArr) = Arr(iArr)
End If
Next
End If
' ReDim Preserve is an expensive function, do it only once
ReDim Preserve NewArr(LBound(Arr) To iNewArr)
DeleteItemConditionally = NewArr
Exit Function
AbortExit:
On Error Resume Next
DeleteItemConditionally = Arr
End Function
Public Function IsArrayAllocated(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayAllocated
' Returns TRUE if the array is allocated (either a static array or a dynamic array that has been
' sized with Redim) or FALSE if the array is not allocated (a dynamic that has not yet
' been sized with Redim, or a dynamic array that has been Erased). Static arrays are always
' allocated.
'
' The VBA IsArray function indicates whether a variable is an array, but it does not
' distinguish between allocated and unallocated arrays. It will return TRUE for both
' allocated and unallocated arrays. This function tests whether the array has actually
' been allocated.
'
' This function is just the reverse of IsArrayEmpty.
'
' From http://www.cpearson.com/Excel/VBAArrays.htm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
On Error Resume Next
' if Arr is not an array, return FALSE and get out.
If IsArray(Arr) = False Then
IsArrayAllocated = False
Exit Function
End If
' Attempt to get the UBound of the array. If the array has not been allocated,
' an error will occur. Test Err.Number to see if an error occurred.
N = UBound(Arr, 1)
If (Err.Number = 0) Then
''''''''''''''''''''''''''''''''''''''
' Under some circumstances, if an array
' is not allocated, Err.Number will be
' 0. To acccomodate this case, we test
' whether LBound <= Ubound. If this
' is True, the array is allocated. Otherwise,
' the array is not allocated.
'''''''''''''''''''''''''''''''''''''''
If LBound(Arr) <= UBound(Arr) Then
' no error. array has been allocated.
IsArrayAllocated = True
Else
IsArrayAllocated = False
End If
Else
' error. unallocated array
IsArrayAllocated = False
End If
End Function
Public Function NumberOfArrayDimensions(Arr As Variant) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NumberOfArrayDimensions
' This function returns the number of dimensions of an array. An unallocated dynamic array
' has 0 dimensions. This condition can also be tested with IsArrayEmpty.
'
' From http://www.cpearson.com/Excel/VBAArrays.htm
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
' Loop, increasing the dimension index Ndx, until an error occurs.
' An error will occur when Ndx exceeds the number of dimension
' in the array. Return Ndx - 1.
Do
Ndx = Ndx + 1
Res = UBound(Arr, Ndx)
Loop Until Err.Number <> 0
NumberOfArrayDimensions = Ndx - 1
End Function