VBA脚本问题：累加第4列至≤E1值时选中对应行

我需要写一段VBA脚本，累加第4列（Value列）的数值，直到总和小于等于E1单元格的值（当前E1值为180000），并选中所有符合条件的行。

我自己写了循环代码计算第4列的总和，但当总和永远达不到目标值时会报错；只有当E1值小于第4列的总和时，代码才能正常运行。

现有代码如下：

Sub test()
    Dim TempReq As Long
    Set sht = Worksheets("TempReq")
    lrD = sht.Cells(Rows.Count, 4).End(xlUp).row

    For i = 1 To lrD
        j = 1
        TempReq = TempReq + sht.Cells(i, 4).Value
        If TempReq >= sht.Cells(j, 5).Value Then
            Set rng = sht.Range("a1:d" & i)
        End If
    Next i
    rng.Select
End Sub

修正后的代码 #

Sub SelectRowsUntilSum()
    Dim TempReq As Double ' 改用Double避免整数溢出
    Dim sht As Worksheet
    Dim lrD As Long, i As Long
    Dim targetValue As Double
    Dim rng As Range
    
    Set sht = Worksheets("TempReq")
    targetValue = sht.Cells(1, 5).Value ' 直接获取E1的目标值
    lrD = sht.Cells(sht.Rows.Count, 4).End(xlUp).Row
    
    ' 初始化变量
    TempReq = 0
    Set rng = Nothing
    
    For i = 2 To lrD ' 跳过表头，从第2行数据行开始累加
        ' 先判断当前行加入后是否超过目标，再执行操作
        If TempReq + sht.Cells(i, 4).Value <= targetValue Then
            TempReq = TempReq + sht.Cells(i, 4).Value
            ' 逐步构建选中区域
            If rng Is Nothing Then
                Set rng = sht.Range("A" & i & ":D" & i)
            Else
                Set rng = Union(rng, sht.Range("A" & i & ":D" & i))
            End If
        Else
            ' 加入当前行后超过目标，停止循环
            Exit For
        End If
    Next i
    
    ' 处理所有行总和仍小于目标的情况
    If rng Is Nothing Then
        Set rng = sht.Range("A2:D" & lrD)
    End If
    
    ' 执行选中操作
    rng.Select
End Sub

关键修正点 #

1. 变量类型优化：用Double存储总和，避免大数累加时的整数溢出问题。
2. 循环起始行调整：跳过第1行的表头，从第2行数据行开始累加。
3. 逻辑顺序修正：先判断累加后是否符合条件，再执行累加和选中操作，避免超过目标的行被误选。
4. 空值处理：当所有行总和都小于目标值时，自动选中全部数据行，避免rng未初始化导致的报错。
5. 冗余代码清理：移除循环内重复赋值的j=1，直接通过sht.Cells(1,5)获取目标值。

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