如何缩短VBA数组长度，仅保留含16250的元素？

你的问题根源在于一开始就把shArr定义成了和原数组A完全相同的尺寸，哪怕只有部分行符合条件，数组总长度也不会改变，自然会留下大量空元素。要解决这个问题，需要先统计符合条件的行数，再根据实际数量调整目标数组的大小，最后将符合条件的行连续存入目标数组。

修改后的代码 #

Dim A(), i As Long, j As Integer, count As Long, k As Long
nr = WorksheetFunction.CountA(Range(Cells(2, 1), Cells(2, 1).End(xlDown))) + 1
nc = Range(Cells(2, 1), Cells(2, 1).End(xlToRight)).Columns.Count

' 初始化原数组A()
ReDim A(3 To nr, 1 To nc)
For i = 3 To nr
    For j = 1 To nc
        A(i, j) = Cells(i, j)
    Next j
Next i

' 第一步：统计包含"16250"的行数
count = 0
For i = 3 To nr
    If Left(A(i, 4), 5) = "16250" Then
        count = count + 1
    End If
Next i

' 第二步：根据统计结果初始化目标数组shArr
ReDim shArr(1 To count, 1 To nc) ' 若要保持起始行索引和原数组一致，可改为ReDim shArr(3 To 3 + count - 1, 1 To nc)

' 第三步：将符合条件的行连续存入shArr
k = 1 ' 目标数组的行计数器，若起始索引改3则设为3
For i = 3 To nr
    If Left(A(i, 4), 5) = "16250" Then
        For j = 1 To nc
            shArr(k, j) = A(i, j)
        Next j
        k = k + 1 ' 每存入一行，计数器自增
    End If
Next i

关键改动说明 #

• 统计有效行数：先遍历原数组，数出所有符合条件的行的数量，确保目标数组大小精准匹配实际需要存储的数据量。
• 动态调整数组尺寸：通过ReDim根据统计出的count值重新定义shArr的行范围，彻底避免多余空元素。
• 连续存储有效数据：用计数器跟踪目标数组的当前行号，每找到符合条件的行就直接存入计数器对应的位置，保证数据连续无空隙。

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