从数组中删除所有特定元素的VBA函数

Question

如何编写一个 vba 函数，删除数组中具有给定值的所有元素。 我相信函数定义如下所示：

Function removeAllFromArray(element as Variant, myArray as Variant) as Boolean

...

removeAllFromArray = ? 
- True if all removed with the given value (element)
- Else it's False
End Function 

Function removeAllFromArray(ByRef element As Variant, ByRef a As Variant) As Boolean
    Dim i As Integer
    Dim iter As Variant
    For Each iter In a
        If iter = element Then
            a.Remove (iter)
        End If
    Next iter
    removeAllFromArray = arrayContainsA(a, element)
End Function

arrayContainsA 函数的位置如下所示：

Function arrayContainsA(ByRef arrayOfSearch As Variant, ByRef searchedElement As Variant) As Boolean
    Dim element As Variant
    For Each element In arrayOfSearch
        If element = searchedElement Then
            arrayContainsA = True
            Exit Function
        End If
    Next element
    arrayContainsA = False
    Exit Function
End Function

根本不起作用。

Answer 1

数组不是集合，并且没有

Remove

方法。
您也不能使用

For Each

循环修改数组的元素，您必须显式引用数组的元素。为此，您需要知道数组有多少维。
如果数组的维度不超过 2 个，则可以使用以下代码，如果数组可以有更多维度（极少数情况），则需要扩展代码。

Function removeAllFromArray(ByRef element As Variant, ByRef a As Variant) As Boolean
    Dim i As Integer, j As Integer, s As Long
    If IsArray(a) Then
        On Error Resume Next
        s = UBound(a, 2)
        s = Err <> 0 ' 1 dim
        On Error GoTo 0
        If s = 0 Then
            For i = LBound(a) To UBound(a)
                For j = LBound(a, 2) To UBound(a, 2)
                    If a(i, j) = element Then a(i, j) = Empty
            Next j, i
        Else
            For i = LBound(a) To UBound(a)
                If a(i) = element Then a(i) = Empty
            Next i
        End If
    Else
        If a = element Then a = Empty
    End If
    removeAllFromArray = arrayContainsA(a, element)
End Function

Function arrayContainsA(ByRef arrayOfSearch As Variant, _
                        ByRef searchedElement As Variant) As Boolean
    Dim element As Variant
    For Each element In arrayOfSearch
        If element = searchedElement Then
            arrayContainsA = True
            Exit Function
        End If
    Next element
End Function

Sub Test()
    Dim MyArr(1 To 5) As Long
    Dim i As Long
    For i = 1 To 5
        MyArr(i) = i
    Next i
    Debug.Print removeAllFromArray(2, MyArr)
    Dim MyArr2(1 To 5, 1 To 1) As Long
    For i = 1 To 5
        MyArr2(i, 1) = i
    Next i
    Debug.Print removeAllFromArray(2, MyArr2)
    
End Sub

Answer 2

嗯，VBA中的数组没有这样的

Remove

属性...

数组字段很大而且相当复杂。在下一个代码中，我将尝试解释如何在不迭代的情况下从 1D 数组中删除元素。

您将在

Immediate Window

中看到每个代码序列返回。可以看到按

Ctrl + G

，处于 Visual Basic for Application Editor (VBE) 中：

Sub PlayWith1DArrays()
  Dim arr, i As Long
  ReDim arr(5) '(0 To 5) = 6 elements...
  For i = 0 To 5
    arr(i) = i
  Next i
  Debug.Print Join(arr, "|")  'just tp see the loaded aray
  arr = filter(arr, 1, False) 'remove the 1 element
  Debug.Print Join(arr, "|")  'it returns 0|2|3|4|5
  
  'But loading the array in a similar way, WITH MORE ELEMENTS,
  'making it to load MORE elements CONTAINING 1:
  ReDim arr(1 To 15)
  For i = 1 To UBound(arr)
    arr(i) = i
  Next i
  Debug.Print Join(arr, "|") 'the loaded array
  arr = filter(arr, 1, False)
  Debug.Print Join(arr, "|") 'it returns 2|3|4|5|6|7|8|9
                             'it performs a textual comparison...
                             'removing elements containing 1 character.
                             
  'But you can use a TRICK to remove the EXACT (string) element:
  ReDim arr(1 To 15)
  For i = 1 To UBound(arr)
    arr(i) = "arr " & i
  Next i
  Debug.Print Join(arr, "|") 'the loaded array by iteration
  Dim elToRemove As String: elToRemove = "Arr 1" 'the element to be removed (no case sensitive...)
  Dim mtch
  Const strangeString As String = "xx$_$##" 'a strimg extremely improbable to be
                                            'contained by that array elements
  mtch = Application.match(elToRemove, arr, 0)
  If IsNumeric(mtch) Then  'if it exists in the array
    arr(mtch) = strangeString
    arr = filter(arr, strangeString, False)
  End If
  Debug.Print Join(arr, "|") 'it returns the array without its first element...
                             'arr 2|arr 3|arr 4|arr 5|arr 6|arr 7|arr 8|arr 9|arr 10|arr 11|arr 12|arr 13|arr 14|arr 15
                             'ReDim arr(1 To 15)...
                             
  'But this is happening when the LBound of the array is 1...
  'Otherwise, you need to check it and adapt:
  ReDim arr(14) ' (0 to 14)...
  For i = LBound(arr) To UBound(arr)
    arr(i) = "arr " & i
  Next i
  Debug.Print Join(arr, "|") 'the loaded array by iteration
  Debug.Print "LBound of arr = " & LBound(arr) 'LBound of the array declared as ReDim arr(14) is zero...
  mtch = Application.match(elToRemove, arr, 0)
  If IsNumeric(mtch) Then  'if it exists in the array
    arr(IIf(LBound(arr) = 0, mtch - 1, 1)) = strangeString 'match returns 1 for the first array element
                                                           'in a 1D array, without Option Base 1 or without
                                                           'ReDim with LBound different than 0, is zero!
    arr = filter(arr, strangeString, False)
  End If
  Debug.Print Join(arr, "|") 'it returns the array without its second element...
                             'arr 0|arr 2|arr 3|arr 4|arr 5|arr 6|arr 7|arr 8|arr 9|arr 10|arr 11|arr 12|arr 13|arr 14
  
  'A 2D array with a single column and a single row can be easily transformed in a 1D type and use the above
  'explained rules:
  ReDim arr(1 To 11, 1 To 1) 'a single column...
  For i = 1 To UBound(arr)
    arr(i, 1) = "arr " & i
  Next i
  arr = Application.Transpose(arr) 'transform it in 1D array by transposing...
  Debug.Print Join(arr, "|")       'the loaded array by iteration
  
  ReDim arr(1 To 1, 1 To 11) 'a single row...
  For i = 1 To UBound(arr, 2) 'the columns number
    arr(1, i) = "arr " & i
  Next i
  arr = Application.Transpose(Application.Transpose(arr)) 'transform it in 1D array by DOUBLE transposing...
  Debug.Print Join(arr, "|")       'the loaded array by iteration
  
  'proceed as above to filter it...
End Sub

我使用

Join

函数只是为了直观地看到对迭代加载的数组的处理/过滤/删除返回...

在二维数组中，按行或按列过滤元素要复杂得多...基本上可以通过迭代来完成。

如果有不清楚的地方，请随时专门要求澄清。

请在测试后发送一些反馈。