VBA使用FollowHyperlink导入多工作簿数据时持续闪屏问题咨询

• FollowHyperlink方法内置跳转逻辑，会强制激活并显示新打开的工作簿窗口，即使设置了ScreenUpdating = False也会触发重绘
• 循环内的DoEvents会强制交还系统控制权，处理所有待执行的窗口重绘请求，直接打破屏幕更新关闭的限制
• 频繁的剪贴板操作、工作簿切换操作都会触发不必要的界面刷新

• 用Workbooks.Open替换FollowHyperlink，新增Visible:=False参数后台打开源文件，完全不显示外部文件窗口
• 删除循环内的DoEvents语句
• 用直接单元格值赋值替换Copy/PasteSpecial操作，跳过剪贴板，同时提升运行效率
• 补充设置Application.EnableEvents = False，避免打开外部文件时触发内置事件导致额外刷新
• 移除不必要的单元格激活操作，减少界面触发
• 修正代码中多余的End If语法错误，补充空引用异常处理

Sub ImportDataMultiFiles()
    Dim RangeOne As Range
    Dim LastRow As Long ' 原Integer最大仅支持32767行，替换为Long避免溢出
    Dim PathFile As String
    Dim i As Long
    Dim c As Integer
    Dim wkSheetName As String
    Dim wbSrc As Workbook ' 直接存源文件对象引用，避免按名称引用出错
    Dim wsTarget As Worksheet ' 缓存主表对象，减少重复调用开销

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False ' 新增：关闭事件触发
        .StatusBar = "Updating Spreadsheet" ' 修正原拼写错误Upadating
        .Calculation = xlCalculationManual
    End With

    ' 缓存主表对象，避免重复调用ActiveSheet出错
    Set wsTarget = ThisWorkbook.ActiveSheet
    wkSheetName = wsTarget.Name

    LastRow = wsTarget.Cells(wsTarget.Rows.Count, 2).End(xlUp).Row
    Set RangeOne = wsTarget.Range("B3", "B" & LastRow)

    For i = 3 To LastRow
        ' 删除原DoEvents语句
        If wsTarget.Range("B" & i).Value <> "" Then
            ' 提取超链接地址
            PathFile = wsTarget.Range("B" & i).Hyperlinks(1).Address
            
            ' 后台打开源文件，不显示窗口，替换原FollowHyperlink
            Set wbSrc = Workbooks.Open(PathFile, Visible:=False)
            
            ' 直接值赋值，替换Copy/PasteSpecial
            For c = 1 To 34
                If wsTarget.Cells(i, c + 7).Value = "" Then
                    wsTarget.Cells(i, c + 7).Value = wbSrc.Worksheets("Case Info").Cells(2, c).Value
                End If
            Next c
            
            ' 关闭源文件，不保存
            wbSrc.Close SaveChanges:=False
            Set wbSrc = Nothing ' 清理对象引用
        End If
    Next i

    MsgBox "Data successfully imported"

    ' 恢复应用设置
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
        .StatusBar = ""
        .Calculation = xlCalculationAutomatic
    End With

    ' 释放对象
    Set wsTarget = Nothing
End Sub

• 原代码中If wkSheetName = "Data1"的两个分支逻辑完全一致，已合并简化，不改变原有运行逻辑
• 原代码中CellUsed、PathFolder、UserRange定义后未使用，已删除
• 原代码中多余的End If语法错误已修正

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