Excel VBA中如何基于已定义数组生成指定目标新数组

我在Excel VBA中定义了数组A：A = Array(20082, 20081, 20092, 20091, 20102, 20101, 20112, 20111, 20122, 20121)，希望基于A生成新数组B：B = Array(20092, 20091, 20102, 20101, 20112, 20111, 20122)。编写了如下VBA代码，但运行结果与预期不符，请问该如何调整？

原代码 #

Sub CreateNewArray()
    Dim A() As Variant
    Dim NewArray() As Variant
    Dim i As Long
    Dim j As Long
    
    ' Define your original array A
    A = Array(20082, 20081, 20092, 20091, 20102, 20101, 20112, 20111, 20122, 20121)
    
    ' Initialize the index for the new array
    j = 0
    
    ' Loop through the elements of array A
    For i = LBound(A) To UBound(A)
        ' Check if the element is within the desired range
        If A(i) >= 20092 And A(i) <= 20122 Then
            ' Add the element to the new array
            ReDim Preserve NewArray(j)
            NewArray(j) = A(i)
            j = j + 1
        End If
    Next i
    
    ' Print the new array (optional)
    For i = LBound(NewArray) To UBound(NewArray)
        Debug.Print NewArray(i)
    Next i
End Sub

预期结果 #

20092
20091
20102
20101
20112
20111
20122

问题分析 #

原代码的筛选条件A(i) >= 20092 And A(i) <= 20122错误排除了20091、20101、20111这些预期要保留的元素，同时错误保留了20121。需要调整筛选逻辑，准确匹配目标元素。

修正方案 #

方案1：调整范围判断条件 #

直接修改判断逻辑，保留20091及以上且排除20121的元素：

Sub CreateNewArray()
    Dim A() As Variant
    Dim NewArray() As Variant
    Dim i As Long
    Dim j As Long
    
    A = Array(20082, 20081, 20092, 20091, 20102, 20101, 20112, 20111, 20122, 20121)
    j = 0
    
    For i = LBound(A) To UBound(A)
        ' 筛选条件：保留20091及以上，且排除20121
        If (A(i) >= 20091 And A(i) <= 20122) And A(i) <> 20121 Then
            ReDim Preserve NewArray(j)
            NewArray(j) = A(i)
            j = j + 1
        End If
    Next i
    
    ' 打印结果
    For i = LBound(NewArray) To UBound(NewArray)
        Debug.Print NewArray(i)
    Next i
End Sub

方案2：精准匹配目标元素集合 #

如果目标元素是固定集合，可通过辅助函数检查元素是否在目标列表中，筛选更精准：

Sub CreateNewArray()
    Dim A() As Variant
    Dim NewArray() As Variant
    Dim targetElements As Variant
    Dim i As Long
    Dim j As Long
    
    A = Array(20082, 20081, 20092, 20091, 20102, 20101, 20112, 20111, 20122, 20121)
    targetElements = Array(20092, 20091, 20102, 20101, 20112, 20111, 20122)
    j = 0
    
    For i = LBound(A) To UBound(A)
        ' 检查当前元素是否在目标集合中
        If IsInArray(A(i), targetElements) Then
            ReDim Preserve NewArray(j)
            NewArray(j) = A(i)
            j = j + 1
        End If
    Next i
    
    ' 打印结果
    For i = LBound(NewArray) To UBound(NewArray)
        Debug.Print NewArray(i)
    Next i
End Sub

' 辅助函数：判断元素是否存在于数组中
Function IsInArray(value As Variant, arr As Variant) As Boolean
    Dim element As Variant
    For Each element In arr
        If element = value Then
            IsInArray = True
            Exit Function
        End If
    Next element
    IsInArray = False
End Function

内容的提问来源于stack exchange，提问作者aly