如何修改VBA代码使其分析完当前行后自动跳转至下一行处理

问题原因 #

你当前的代码固定写死了行号2，没有使用动态变量记录当前处理的行号，也没有在每次循环后更新目标粘贴位置，所以会一直重复处理第2行，而且粘贴内容会互相覆盖。

优化后可直接运行的代码 #

Sub 筛选符合条件的测试资格学生()
    Dim baseSheet As Worksheet, iosSheet As Worksheet, androidSheet As Worksheet
    Dim currentRow As Long, iosTargetRow As Long, androidTargetRow As Long
    
    ' 提前绑定工作表，避免重复调用Sheets()提升效率
    Set baseSheet = Sheets("BASE")
    Set iosSheet = Sheets("IOS YES")
    Set androidSheet = Sheets("ANDROID YES")
    
    ' 初始化行号：BASE表从第2行开始处理，两个目标表也从第2行开始粘贴（假设第1行是表头）
    currentRow = 2
    iosTargetRow = 2
    androidTargetRow = 2
    
    ' 遍历BASE表直到D列空行停止
    While baseSheet.Range("D" & currentRow).Value <> ""
        ' 判断IOS符合资格的情况
        If baseSheet.Range("D" & currentRow).Value = "IOS" And baseSheet.Range("E" & currentRow).Value = "Y" Then
            baseSheet.Range("A" & currentRow & ":E" & currentRow).Copy _
                Destination:=iosSheet.Range("A" & iosTargetRow)
            ' IOS目标行行号+1，下次粘贴到下一行避免覆盖
            iosTargetRow = iosTargetRow + 1
        ' 判断ANDROID符合资格的情况
        ElseIf baseSheet.Range("D" & currentRow).Value = "ANDROID" And baseSheet.Range("E" & currentRow).Value = "Y" Then
            baseSheet.Range("A" & currentRow & ":E" & currentRow).Copy _
                Destination:=androidSheet.Range("A" & androidTargetRow)
            ' ANDROID目标行行号+1
            androidTargetRow = androidTargetRow + 1
        End If
        ' 处理下一行BASE表数据
        currentRow = currentRow + 1
    Wend
    
    ' 清空剪贴板，取消复制选中状态
    Application.CutCopyMode = False
End Sub

核心改动说明 #

• 新增了currentRow变量记录BASE表当前处理的行号，每次循环结束后自动+1，实现逐行遍历
• 新增了iosTargetRow、androidTargetRow两个变量记录两个目标表的下次粘贴位置，避免新粘贴的内容覆盖旧数据
• 去掉了所有无意义的Select操作，直接指定复制的目标位置，代码运行效率更高，也不会出现屏幕闪跳的问题
• 提前绑定所有用到的工作表，减少重复对象调用的性能损耗

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