无法摆脱阵列中不需要的物品

时间:2019-09-02 19:31:43

标签: arrays excel vba

我正在尝试找出从列表中踢出不需要的项目的任何方法。例如,我希望从列表中删除4790,因为它们不符合条件。我在脚本中使用了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)

3 个答案:

答案 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