求助，各位老师帮帮忙，一下代码运行到一半提示下标越界(已解决)

冰叶雕翎

代码的要求是从工作表中A列找出一些数相加等于B1的值，把找出的数据一次保存的C列中，但运行到ReDim Preserve arrNums(0 To UBound(arrNums) - 1)时提示越界，麻烦各位老师帮忙修改，谢谢

Sub findNumbers()
    Dim rngA As Range, cell As Range
    Dim sumValue As Double, num As Double
    Dim arrNums() As Double, i As Integer, j As Integer
    Dim found As Boolean

    '设置A列的范围
    Set rngA = Range("A:A")

    '设置目标固定值
    sumValue = Range("B1").Value '获取固定值B1

    '清空C列
    Range("C:C").ClearContents

    '遍历A列中每一个单元格
    For Each cell In rngA
        '取出当前单元格的数值
        num = cell.Value

        '判断当前数值是否小于目标固定值
        If num < sumValue Then
            '将当前数值从之前找到的数值中去掉，并将剩余的数值保存到数组中
            ReDim Preserve arrNums(0 To UBound(arrNums) - 1)‘本行代码提示错误，下标越界
            For i = 0 To UBound(arrNums)
                If arrNums(i) <> num Then
                    arrNums(j) = arrNums(i)
                    j = j + 1
                End If
            Next i

            '将当前数值加入数组中
            ReDim Preserve arrNums(0 To UBound(arrNums) + 1)
            arrNums(UBound(arrNums)) = num

            '判断数组中的数值是否等于目标固定值
            If WorksheetFunction.Sum(arrNums) = sumValue Then
                '将找到的数值保存到C列
                For i = 0 To UBound(arrNums)
                    Range("C" & cell.Row).Offset(0, i).Value = arrNums(i)
                Next i
                '清空数组和计数器
                Erase arrNums
                j = 0
                found = True
            Else
                found = False
            End If
        End If

        '如果找到了符合条件的数值，则跳出循环
        If found Then Exit For
    Next cell
End Sub

DevilW

gwjkkkkk

这个凑数吧
https://club.excelhome.net/threa ... tml?_dsign=293310a7

512008404

844265121

学习一下   

冰叶雕翎

DevilW 发表于 2023-7-19 15:42

感谢百忙中抽空帮忙，经过指导问题已解决，谢谢

冰叶雕翎

gwjkkkkk 发表于 2023-7-19 20:11
这个凑数吧
https://club.excelhome.net/thread-1584367-1-1.html?_dsign=293310a7

感谢百忙中抽空帮忙，经过指导问题已解决，不过您发的这个比我的好用太多了，十分谢谢

冰叶雕翎

512008404 发表于 2023-7-19 23:02

感谢百忙中抽空帮忙，经过指导问题已解决，谢谢