Excel VBA循环增量问题：跨表查找复制直至STOP_4

你的代码存在几处逻辑缺陷，无法准确实现需求，以下是问题点和修正方案：

原代码的核心问题 #

• 循环终止逻辑错误：Do While Not rngX Is Nothing的条件永远不会触发终止（除非遍历到工作表最后一行），因为每次Set rngX = rngX.Offset(1, 0)只会让单元格下移，不会让rngX变成Nothing。原有的If rngX.Offset(1, 0).Value = "STOP_4" Then Exit Do也会漏掉对当前行的处理，且如果START下一行就是STOP_4，会直接跳过所有操作。
• 冗余的复制粘贴：将X表的值复制到Y表B1再查找，完全可以直接用单元格值去查找，无需占用剪贴板和额外单元格。
• 查找逻辑不严谨：Find方法默认是部分匹配，可能会找到包含目标值的单元格而非精确匹配，需要指定LookAt:=xlWhole参数。
• 行增量逻辑混乱：原代码中先操作rngX.Offset(1,0)，再下移rngX，容易导致索引错位。

修正后的代码 #

Option Explicit
Sub Loop100()
    ' 定义变量
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim wsX As Worksheet: Set wsX = wb.Sheets("X")
    Dim wsY As Worksheet: Set wsY = wb.Sheets("Y")
    Dim rngX As Range
    Dim rngY As Range
    Dim strStart As String: strStart = "START"
    Dim currentValue As Variant
    
    ' 在X表中查找START单元格
    Set rngX = wsX.Cells.Find(strStart)
    ' 如果没找到START，直接退出
    If rngX Is Nothing Then Exit Sub
    
    ' 下移到START的下一行，开始处理数据
    Set rngX = rngX.Offset(1, 0)
    
    ' 循环直到遇到STOP_4
    Do While rngX.Value <> "STOP_4"
        currentValue = rngX.Value
        
        ' 在Y表的A2:E100区域精确查找当前值
        Set rngY = wsY.Range("A2:E100").Find(What:=currentValue, LookAt:=xlWhole)
        
        ' 如果找到匹配值，将偏移6列的值写入X表当前行的第5列（偏移4列）
        If Not rngY Is Nothing Then
            rngX.Offset(0, 4).Value = rngY.Offset(0, 6).Value
        End If
        
        ' 下移一行，继续循环
        Set rngX = rngX.Offset(1, 0)
        
        ' 防止无限循环（如果没找到STOP_4，遍历到空行就停止）
        If IsEmpty(rngX.Value) Then Exit Do
    Loop
End Sub

修正说明 #

1. 修正循环终止逻辑：直接判断当前rngX的值是否为STOP_4，同时增加空行判断防止无限循环。
2. 移除冗余复制操作：直接读取X表单元格的值进行查找，避免剪贴板操作，提升效率。
3. 精确查找：添加LookAt:=xlWhole确保只匹配完全一致的单元格值。
4. 简化行增量逻辑：先处理当前行，再下移单元格，逻辑更清晰，避免索引错位。

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