VBA循环中变量i未更新导致重复执行问题求助

我编写了一段VBA代码，用于从ID列表中查找并打开对应文件，复制指定单元格区域（B42:B53）后返回主工作簿粘贴。目前循环可运行，但变量i未更新，导致代码重复处理同一区域，Origen值也未随i递增变化。

原代码 #

Sub Foo

Dim Maestro            As Workbook 
Dim Libro_FormularioWB As Worksheet 
Dim Origen_Datos       As String


Dim i             As String 
Dim Carpeta       As String 
Dim Archivo       As String 
Dim Ruta          As String 
Dim Formato       As String 
Dim Errores       As Integer 
Dim Formulario    As String 
Dim Buscar_Cedula As Range 
Dim Cedula        As Integer

i           = 5 
Set Maestro = ThisWorkbook 
Carpeta     = ActiveWorkbook.Path 
Formato     = ".xlsm" 
Origen      = ThisWorkbook.Sheets("Data").Range("a" & i) 
x           = ThisWorkbook.Sheets("Data").Range("a" & i) 
Formulario  = Carpeta & "" & ThisWorkbook.Sheets("Data").Range("a" & i) & Formato 

Set Buscar_Cedula = Maestro.Sheets("Resultados").Range("b1:zz1")

Do While ThisWorkbook.Sheets("Data").Range("a" & i) <> "" 
    If ThisWorkbook.Sheets("Data").Range("a" & i) > "" Then 
        ActiveWorkbook.FollowHyperlink Formulario 

        Windows(Origen & Formato).Activate 
        Range("B42:B53").Select 
        Application.CutCopyMode = False 
        Selection.Copy 
        Windows("ARCHIVO MAESTRO.xlsm").Activate 
        Maestro.Sheets("Resultados").Select 
        Application.WorksheetFunction.XLookup(x, Buscar_Cedula, Buscar_Cedula, , 0, 1).Offset(1, 0).Select 
        Selection.PasteSpecial Paste := xlPasteValues, Operation := xlNone, 
        SkipBlanks _ := False, Transpose := False 
        Windows(Origen & Formato).Close SAVECHANGES := False

        On Error Resume Next 
        i = i + 1 
        Errores = Errores + 1

Loop

End Sub

问题分析与修复 #

核心问题点 #

1. 变量类型错误：i被定义为String类型，执行i = i + 1时会触发字符串拼接而非数值递增，导致循环无法推进。
2. 关键变量未循环更新：Origen、x、Formulario的赋值写在循环外部，每次循环都使用初始值，不会读取新行的ID。
3. 语法错误：Sub Foo缺括号、If语句未闭合、PasteSpecial代码换行格式错误，这些都会导致代码运行异常。
4. 错误捕获位置不当：On Error Resume Next放在循环末尾，会掩盖前面操作的错误，且未及时恢复错误捕获状态。
5. 依赖Select/Activate：频繁切换激活窗口和选区，容易导致代码不稳定，应该直接操作对象。

修正后的代码 #

Sub Foo()
    Dim Maestro            As Workbook
    Dim wsData             As Worksheet
    Dim wsResultados       As Worksheet
    Dim Origen             As String
    Dim i                  As Integer ' 修正为数值类型
    Dim Carpeta            As String
    Dim Formato            As String
    Dim Errores            As Integer
    Dim Formulario         As String
    Dim Buscar_Cedula      As Range
    Dim x                  As String
    Dim targetCell         As Range
    
    ' 初始化对象，避免依赖Active对象
    Set Maestro = ThisWorkbook
    Set wsData = Maestro.Sheets("Data")
    Set wsResultados = Maestro.Sheets("Resultados")
    Carpeta = Maestro.Path
    Formato = ".xlsm"
    i = 5
    
    Set Buscar_Cedula = wsResultados.Range("B1:ZZ1")
    
    Do While wsData.Range("A" & i).Value <> ""
        ' 每次循环重新读取当前行的ID
        Origen = wsData.Range("A" & i).Value
        x = Origen
        Formulario = Carpeta & "\" & Origen & Formato ' 补充路径分隔符
        
        ' 检查文件是否存在，避免报错
        If Dir(Formulario) <> "" Then
            On Error Resume Next ' 仅在打开文件时启用错误捕获
            Dim wbOrigen As Workbook
            Set wbOrigen = Workbooks.Open(Formulario)
            On Error GoTo 0 ' 恢复默认错误捕获
            
            If Not wbOrigen Is Nothing Then
                ' 直接操作对象，避免Select/Activate
                wbOrigen.Sheets(1).Range("B42:B53").Copy
                ' 查找目标单元格并粘贴
                Set targetCell = wsResultados.Range("B1:ZZ1").Find(What:=x, LookIn:=xlValues, LookAt:=xlWhole)
                If Not targetCell Is Nothing Then
                    targetCell.Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                End If
                
                wbOrigen.Close SaveChanges:=False
                Application.CutCopyMode = False
            Else
                Errores = Errores + 1
            End If
        Else
            Errores = Errores + 1
        End If
        
        i = i + 1 ' 确保每次循环后递增i
    Loop
End Sub

关键修改说明 #

• 将i的类型改为Integer，保证数值递增逻辑正常。
• 把Origen、x、Formulario的赋值移到循环内部，每次循环读取当前行的ID。
• 替换FollowHyperlink为Workbooks.Open，直接操作工作簿对象，提升可控性。
• 移除所有Select/Activate操作，通过对象引用直接操作单元格和工作簿，增强代码稳定性。
• 添加文件存在检查，避免打开不存在的文件触发错误。
• 调整错误捕获范围，仅在可能出错的步骤（打开文件）启用，避免掩盖其他问题。
• 补充路径分隔符\，确保文件路径拼接正确。

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