Question

我正在尝试使用dataRange范围内>0范围内的值填充数组，但它无法正常运行

Dim kRow As Variant, cell As Range, dataRange As Range
Set dataRange = ws.Range("AE4", ws.Range("AE4").End(xlDown))

ReDim kRow(0)
For Each cell In dataRange
    If cell.Value > 0 Then
        kRow(UBound(kRow)) = cell.Value
        ReDim Preserve kRow(UBound(kRow) + 1)
    End If
Next cell
ReDim Preserve kRow(UBound(kRow) - 1)

当查看本地窗口时，>0似乎没有找到任何kRow

出了什么问题？

Answer 1

只有在AE4中找不到任何值时，代码才会出现问题。

然后ReDim Preserve kRow(UBound(kRow) - 1)这个会引发错误。

通常在列A中添加一些值并试一试：

Option Explicit

Public Sub TestMe()

    Dim kRow As Variant, cell As Range, dataRange As Range
    Dim i As Long

    Set dataRange = ActiveSheet.Range("A4", ActiveSheet.Range("A4").End(xlDown))

    ReDim kRow(0)
    For Each cell In dataRange
        If cell.Value > 0 Then
            kRow(UBound(kRow)) = cell.Value
            ReDim Preserve kRow(UBound(kRow) + 1)
        End If
    Next cell

    For i = LBound(kRow) To UBound(kRow)
        Debug.Print kRow(i)
    Next i

    'ReDim Preserve kRow(UBound(kRow) - 1)

End Sub

Answer 2

根据您在dataRange中的数据量，加载到临时数组和进程中可能会更快，而不是在工作表上循环单元格。另外ReDim Preserve是一项昂贵的操作，如果可能的话，最好避免使用。

以下代码将dataRange存储在临时数组中，循环临时数组以查找匹配并存储行索引号，重新调整大小kRow以适应然后复制匹配值

Sub PopulateArray()

    Dim ws As Worksheet
    Dim dataRange As Range
    Dim temparr() As Variant, kRow() As Variant
    Dim i As Long, InstanceCount As Long
    Dim RwIndexList As String, Rw As Variant

    Set ws = Sheet1
    Set dataRange = ws.Range("AE4", ws.Range("AE4").End(xlDown))

    'store dataRange in 1D array for processing
    temparr = Application.Transpose(dataRange.Value)

    'loop to determine # of instances > 0
    For i = LBound(temparr) To UBound(temparr)

        If temparr(i) > 0 Then RwIndexList = RwIndexList & "_" & i

    Next i

    'only process if matches found
    If Not RwIndexList = vbNullString Then

        'determine # of matches
        InstanceCount = Len(RwIndexList) - Len(Replace(RwIndexList, "_", ""))

        'resize kRow to match # of instances > 0
        ReDim kRow(1 To InstanceCount)

        'initialize kRow counter
        i = 1

        'copy matching rows to kRow
        For Each Rw In Split(Mid(RwIndexList, 2), "_")

            kRow(i) = temparr(Rw)
            i = i + 1

        Next Rw

    End If

End Sub

另一个只需要一个数组和一个循环的选项就是使用Application.Index对数组进行切片以过滤掉不匹配的行;但这仅适用于2D阵列，因此您将留下2D数组作为输出，不确定这是否适合您？

Sub PopulateArray_Alternative()

    Dim ws As Worksheet, dataRange As Range
    Dim kRow() As Variant, i As Long, RwIndexList As String

    Set ws = Sheet1 'change to suit
    Set dataRange = ws.Range("AE4", ws.Range("AE4").End(xlDown))

    'store dataRange in 2D array for processing
    kRow = dataRange.Value

    'store matching rows in index list
    For i = LBound(kRow) To UBound(kRow)

        If kRow(i, 1) > 0 Then RwIndexList = RwIndexList & "_" & i

    Next i

    'only process if matches found
    If Not RwIndexList = vbNullString Then

        'slice array to filter non-matching rows
        kRow = Application.Index(kRow, Application.Transpose(Split(Mid(RwIndexList, 2), "_")), 0)

    End If

End Sub

正如@Peh所提到的，您可能还想在测试标准中添加一些数据验证，除非您知道所有数据都是数字。

使用大于0的值填充数组

2 个答案: