VBA循环未正常执行求助：遍历AF列时循环中断

原代码的核心问题 #

1. 语法错误：last row是非法变量名，应改为无空格的lastRow，且未定义该变量的取值逻辑。
2. 变量未初始化：ws变量未赋值，直接调用ws.Cells会触发错误。
3. 逻辑块错误：Else 'do nothing之后的激活工作表、粘贴代码不在If条件块内，无论AF列是否为#N/A都会执行粘贴——未执行复制时，粘贴操作会触发运行时错误导致循环中断。
4. 低效操作：频繁用Activate和Select容易因工作表焦点问题出错，还拖慢运行速度。
5. 空列判断漏洞：Range("A1").End(xlDown)找空行时，若A列无数据会直接跳到底部行，引发越界错误。

修复后的完整代码 #

Option Explicit

Sub CopyNAErrors()
    Dim wsExport As Worksheet
    Dim wsErrors As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetRow As Long
    
    ' 绑定工作表对象，避免Activate/Select操作
    Set wsExport = ThisWorkbook.Worksheets("Exported File")
    Set wsErrors = ThisWorkbook.Worksheets("Errors & Resolutions")
    
    ' 获取Exported File工作表AF列的最后一行行号
    lastRow = wsExport.Cells(wsExport.Rows.Count, 32).End(xlUp).Row
    
    ' 遍历AF列（第32列）
    For i = 2 To lastRow
        ' 先判断单元格是否为错误值，再确认是否是#N/A
        If IsError(wsExport.Cells(i, 32).Value) Then
            If wsExport.Cells(i, 32).Value = CVErr(xlErrNA) Then
                ' 获取Errors & Resolutions工作表A列的下一个空行
                targetRow = wsErrors.Cells(wsErrors.Rows.Count, "A").End(xlUp).Row + 1
                ' 直接赋值替代复制粘贴，效率更高
                wsErrors.Cells(targetRow, "A").Value = wsExport.Cells(i, 31).Value
            End If
        End If
    Next i
End Sub

关键修改说明 #

• 加入Option Explicit强制变量声明，避免隐式变量引发的错误。
• 直接绑定工作表对象，彻底移除Activate和Select操作，杜绝焦点问题。
• 先判断单元格是否为错误值，再验证是否为#N/A，防止非错误值与错误值比较触发异常。
• 用Rows.Count结合End(xlUp)获取最后一行，兼容A列无数据的场景。
• 直接赋值替代复制粘贴，大幅提升代码运行效率。

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