VBA For/Find循环无法跳转到下一行的技术问题

问题描述 #

编写的Excel库存管理VBA脚本功能为：在H列搜索指定值DT，若该行D-G列存在指定值BHM或“Misc.”，则将I列的数量加上指定数值；若当前行未找到匹配项，则继续搜索其他行。脚本在大部分场景运行正常，但当H列存在多个相同值的行时，仅能匹配上方行的目标值，无法定位下方行的匹配值。

问题根源 #

1. 错误的Find起始位置：代码中Range("H" & ActiveCell)的写法错误，ActiveCell是Range对象，直接拼接字符串会使用其值而非行号，导致Find方法无法正确定位下一个搜索起始点，重复查找同一行。
2. 依赖Activate/Select操作：使用单元格激活/选择操作容易引发逻辑错误，且不符合VBA最佳实践。
3. 固定循环次数限制：For x = 1 To 10的固定循环次数可能无法覆盖所有匹配行。

修正后的代码 #

Private Sub RemoveStock_Click()
    Dim wsLog As Worksheet
    Dim wsInventory As Worksheet
    Dim DT As String
    Dim BHM As String
    Dim quantity As Double
    Dim DTrng As Range
    Dim firstFoundAddr As String
    Dim cel As Range
    Dim foundMatch As Boolean
    
    ' 初始化工作表对象
    Set wsLog = ThisWorkbook.Sheets("Log")
    Set wsInventory = ThisWorkbook.Sheets("Inventory")
    
    ' 读取用户输入
    wsLog.Range("J1").Value = UserForm1.TextBox1.Text
    wsLog.Range("J2").Value = UserForm1.TextBox2.Text
    wsLog.Range("J3").Value = UserForm1.TextBox3.Text
    wsLog.Range("J4").Value = UserForm1.TextBox4.Text
    
    ' 检查数量输入
    If wsLog.Range("J3").Value = "" Then
        MsgBox "未输入数量"
        Exit Sub
    End If
    quantity = CDbl(wsLog.Range("J3").Value)
    
    ' 获取搜索关键词
    BHM = wsLog.Range("J1").Value
    DT = wsLog.Range("J2").Value
    
    ' 在H列查找第一个DT匹配项
    Set DTrng = wsInventory.Columns("H:H").Find(What:=DT, LookIn:=xlValues, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    
    If Not DTrng Is Nothing Then
        firstFoundAddr = DTrng.Address ' 记录第一个匹配项地址，避免无限循环
        
        Do
            ' 检查当前行D-G列是否存在BHM或Misc.
            foundMatch = False
            For Each cel In wsInventory.Range(DTrng.Offset(0, -4), DTrng.Offset(0, -1))
                If cel.Value = BHM Or cel.Value = "Misc." Then
                    ' 更新I列数量
                    DTrng.Offset(0, 1).Value = DTrng.Offset(0, 1).Value + quantity
                    foundMatch = True
                    Exit For ' 找到匹配项后退出列循环
                End If
            Next cel
            
            If foundMatch Then
                Exit Do ' 找到有效匹配后退出行循环
            End If
            
            ' 查找下一个DT匹配项
            Set DTrng = wsInventory.Columns("H:H").FindNext(DTrng)
            
        Loop While Not DTrng Is Nothing And DTrng.Address <> firstFoundAddr
    End If
    
    ' 提示结果
    If Not foundMatch Then
        MsgBox "未找到匹配的BHM对应明细编号"
    End If
    
    ' 清空输入框内容
    wsLog.Range("J1:J4").ClearContents
End Sub

关键修改说明 #

• 使用工作表对象变量：避免重复引用，提升代码可读性和效率。
• 修正Find逻辑：采用Find+FindNext的标准循环方式，遍历所有DT匹配行，避免遗漏。
• 移除Activate/Select操作：直接通过Range对象操作，消除单元格激活带来的错误。
• 合理的循环终止条件：通过记录第一个匹配项地址，防止无限循环。
• 类型转换：将数量转为Double类型，避免文本格式导致的计算错误。
• 提前退出逻辑：当找到有效匹配后立即终止循环，提升执行效率。

工作表截图 #

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