VBA子过程间变量传递问题求助

问题背景 #

无表头数据：

TT/21-22/079    PROD/22-23/02186    RSM4L50X50X6    16153   6000  
TT/21-22/079    PROD/23-24/04956    RSM4L50X50X6    12950   
TT/21-22/079    PROD/21-22/01818    RSM4L50X50X6    9003    
TT/21-22/079    PROD/21-22/01821    RSM4L50X50X6    8349    
TT/21-22/079    PROD/21-22/01548    RSM4L50X50X6    5418    
TT/21-22/079    PROD/21-22/00794    RSM4L50X50X6    4945    
TT/21-22/079    PROD/23-24/05081    RSM4L50X50X6    4650    

E1单元格值为6000（作为参考值）

需求：

• 第一步：找到最接近E1值且不大于它的行（本例为第5行），记录该行行号；
• 第二步：从该行开始向下累加D列数值，直到累加值达到E1值，选中对应行（本例仅选中第5行）；
• 现有问题：两个子过程间传递行计数器失败，代码仅执行完第一个子过程就停止。

现有代码：

Option Explicit
Dim j As Integer


Sub Compare_First()

Dim resultCell As Range, Dim checkCell As Double, Dim bestDiff As Double
checkCell = Range("E1").Value
bestDiff = checkCell

For j = 1 To Range("D" & Rows.Count).End(xlUp).row
    If Range("D" & j).Value <= checkCell Then
        If (checkCell - Range("D" & j).Value) < bestDiff Then
            bestDiff = checkCell - Range("D" & j)
            Set resultCell = Range("D" & j)
        End If
    End If
Next j
MsgBox "Best match is in " & resultCell.Address
                
Set resultCell = Nothing

End Sub


Sub test()

    Dim TempReq As Long
    Dim sht As Worksheet
    Dim lrD As Long
    Dim i As Integer
    Dim Rng As Range
    maxValue As Long
    
    Set sht = Worksheets("RReq")
    lrD = sht.Cells(Rows.Count, 4).End(xlUp).row
    maxValue = sht.Range("E1").Value
    For i = j To lrD
        TempReq = TempReq + sht.Cells(i, 4).Value
        If TempReq > maxValue Then 'went over the limit
            Set Rng = sht.Range("A1:D" & i - 1)
            Exit For
        End If
    Next i
    If Rng Is Nothing Then 'didn't reach it
        Set Rng = sht.Range("A1:D" & i - 1)
        MsgBox "Maximum never reached"
    Else
        MsgBox "Maximum reached on row " & i - 1
    End If
    Rng.Select 'try not to use Select :)
End Sub

问题分析 #

1. 全局变量j被用作循环变量，循环结束后j的值是最后一行行号，而非找到的匹配行号，这是变量传递的核心错误；
2. Compare_First未主动调用test子过程，导致流程中断；
3. 存在语法错误：Compare_First中重复使用Dim声明变量，test中maxValue未加Dim声明。

修正后的代码 #

Option Explicit
Dim matchRow As Integer ' 用清晰命名替代原j，避免混淆

Sub Compare_First()
    Dim resultCell As Range, checkCell As Double, bestDiff As Double
    checkCell = Range("E1").Value
    bestDiff = checkCell ' 初始化最大差值为参考值本身
    
    Dim lastRow As Integer
    lastRow = Range("D" & Rows.Count).End(xlUp).Row
    
    For Dim j As Integer = 1 To lastRow
        If Range("D" & j).Value <= checkCell Then
            Dim currentDiff As Double
            currentDiff = checkCell - Range("D" & j).Value
            If currentDiff < bestDiff Then
                bestDiff = currentDiff
                Set resultCell = Range("D" & j)
            End If
        End If
    Next j
    
    If Not resultCell Is Nothing Then
        matchRow = resultCell.Row ' 将匹配行号存入全局变量
        MsgBox "Best match is in row " & matchRow
        test ' 主动调用第二个子过程，保证流程连贯
    Else
        MsgBox "No valid match found"
    End If
                
    Set resultCell = Nothing
End Sub

Sub test()
    Dim TempReq As Long
    Dim sht As Worksheet
    Dim lrD As Long
    Dim i As Integer
    Dim Rng As Range
    Dim maxValue As Long ' 补上缺失的Dim声明
    
    Set sht = Worksheets("RReq")
    lrD = sht.Cells(Rows.Count, 4).End(xlUp).Row
    maxValue = sht.Range("E1").Value
    
    TempReq = 0 ' 初始化累加值，避免意外值
    Set Rng = Nothing
    
    For i = matchRow To lrD
        TempReq = TempReq + sht.Cells(i, 4).Value
        ' 区分累加值刚好等于和超过参考值的情况
        If TempReq >= maxValue Then
            If TempReq = maxValue Then
                Set Rng = sht.Range("A" & matchRow & ":D" & i)
            Else
                Set Rng = sht.Range("A" & matchRow & ":D" & i - 1)
            End If
            Exit For
        End If
    Next i
    
    ' 处理累加完所有行仍未达标的情况
    If Rng Is Nothing Then
        Set Rng = sht.Range("A" & matchRow & ":D" & lrD)
        MsgBox "Maximum never reached, selected all rows from match row to end"
    Else
        MsgBox "Maximum reached, selected rows from " & matchRow & " to " & IIf(TempReq = maxValue, i, i - 1)
    End If
    
    ' 建议避免使用Select，直接对Rng进行操作（如需选中可取消注释）
    ' Rng.Select
End Sub

关键修正点 #

• 全局变量命名优化为matchRow，明确其存储匹配行号的作用；
• 在Compare_First中将匹配行的行号赋值给matchRow，而非使用循环后的j；
• 在Compare_First末尾主动调用test，确保流程完整执行；
• 修复语法错误，补充缺失的变量声明；
• 初始化累加变量TempReq，避免异常值；
• 调整选中范围的起始行，从匹配行开始，符合需求逻辑。

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