Excel VBA For Each循环问题：二级循环未从指定行起始

我来帮你搞定这个循环起始位置的问题！你的核心问题在于第二个For Each循环每次都从E列的第一行开始遍历，而不是从当前找到的B列拍卖编号所在行的位置开始。下面我会先分析问题根源，再给出修改后的完整代码，同时优化一些冗余的逻辑。

问题根源分析 #

你当前的代码里，Set rRng2 = Sheet2.Range("E:E")把整个E列都设为了第二个循环的范围，所以每次触发第二个循环时，都会从E1开始找, PA 1，导致总是重复处理最上方的符合条件的单元格，而不是从当前拍卖编号所在行往后找。

修改后的完整代码 #

Sub Macro1()
    Dim rCell As Range
    Dim rCell2 As Range
    Dim rRng As Range
    Dim lastRowE As Long
    Dim startRow As Long
    
    ' 只遍历B列有内容的单元格，提高效率
    Set rRng = Sheet2.Range("B1:B" & Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row)
    lastRowE = Sheet2.Cells(Sheet2.Rows.Count, "E").End(xlUp).Row ' 获取E列最后一行
    
    For Each rCell In rRng
        ' 检查当前单元格是否包含"FEB"，且对应的D列是空的（避免重复处理）
        If InStr(rCell.Value, "FEB") > 0 And Sheet2.Cells(rCell.Row, "D").Value = "" Then
            startRow = rCell.Row ' 记录当前拍卖编号所在行，作为E列查找的起始行
            
            ' 从startRow开始遍历E列到最后一行
            For Each rCell2 In Sheet2.Range("E" & startRow & ":E" & lastRowE)
                If InStr(rCell2.Value, ", PA 1") > 0 Then
                    ' 检查下一行是否也包含", PA 1"，如果是则清空下一行
                    If rCell2.Row < lastRowE And InStr(Sheet2.Cells(rCell2.Row + 1, "E").Value, ", PA 1") > 0 Then
                        Sheet2.Cells(rCell2.Row + 1, "E").Clear
                    End If
                    
                    ' 剪切到对应行的D列
                    rCell2.Cut Destination:=Sheet2.Cells(rCell.Row, "D")
                    Exit For ' 找到第一个符合条件的就退出循环
                End If
            Next rCell2
        End If
    Next rCell
End Sub

关键修改点说明 #

• 缩小循环范围：不再遍历整个B列和E列，而是只遍历有内容的区域，既提高效率又避免处理空单元格。
• 设置E列起始行：用startRow = rCell.Row记录当前拍卖编号的行号，第二个循环从该行开始遍历E列，确保只找当前位置之后的地址单元格。
• 增加重复处理判断：检查D列是否为空，避免已经处理过的拍卖编号重复执行剪切操作。
• 简化嵌套循环：去掉了不必要的For Each rCol In rRng.Columns这类循环，因为我们已经明确是单列操作，不需要遍历列。

额外提示 #

如果你的数据量很大，还可以用Find方法替代第二个For Each循环，查找效率会更高，比如：

' 用Find替代第二个循环
Set rCell2 = Sheet2.Range("E" & startRow & ":E" & lastRowE).Find(What:=", PA 1", LookIn:=xlValues, LookAt:=xlPart)
If Not rCell2 Is Nothing Then
    ' 后续处理逻辑和之前一致
    If rCell2.Row < lastRowE And InStr(Sheet2.Cells(rCell2.Row + 1, "E").Value, ", PA 1") > 0 Then
        Sheet2.Cells(rCell2.Row + 1, "E").Clear
    End If
    rCell2.Cut Destination:=Sheet2.Cells(rCell.Row, "D")
End If

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