如何实现VBA代码等待Excel Query刷新完成后再执行后续操作？

核心问题 #

1. 执行顺序颠倒：原代码中CopyPaste子程序先调用RefreshAll再备份数据，导致备份的是刷新后的新数据，而非包含手动录入值的原始数据，直接导致后续回填无正确数据源。
2. 未等待刷新完成：WaitForDataRefresh子程序未被调用，且仅检查传统QueryTable对象，未覆盖现在常用的Power Query（ListObject）刷新状态。
3. 刷新后未确认数据加载完成：即使关闭后台刷新，部分情况下Excel仍可能存在异步加载延迟，需确保所有查询完全结束后再执行回填。

修改后的完整代码 #

Sub MasterSubroutine()
    On Error GoTo ErrorHandler
    
    ' 先备份原始数据、清除手动列并刷新查询
    CopyPaste
    
    ' 等待所有查询刷新完成
    WaitForAllQueriesToFinish
    
    ' 执行手动值回填
    Lookup
    
    MsgBox "数据备份、查询刷新及手动值回填已完成。", vbInformation
    
    Exit Sub
    
ErrorHandler:
    MsgBox "发生错误: " & Err.Description, vbCritical
    Exit Sub
End Sub

Sub CopyPaste()
    On Error GoTo ErrorHandler
    
    Dim wsSource As Worksheet
    Dim wsBackup As Worksheet
    Dim lastRow As Long
    
    Set wsSource = ThisWorkbook.Sheets("Data")
    Set wsBackup = ThisWorkbook.Sheets("Data Bk Up")
    
    ' 第一步：先备份原始数据（包含手动录入的AA-DP列）
    wsBackup.Cells.Clear
    wsSource.UsedRange.Copy
    wsBackup.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    
    ' 第二步：清除源表手动录入列
    lastRow = wsSource.Cells(wsSource.Rows.Count, "AA").End(xlUp).Row
    If lastRow >= 2 Then
        wsSource.Range("AA2:DP" & lastRow).ClearContents
    End If
    
    ' 第三步：刷新所有查询
    ThisWorkbook.RefreshAll
    
    ' 调整格式（保留原需求）
    wsSource.Rows(1).RowHeight = 65
    wsSource.Range("A1:DP1").WrapText = True
    wsSource.Range("B:C, E:F, I:DP").ColumnWidth = 10
    wsSource.Range("G:I").ColumnWidth = 17
    
    Exit Sub
    
ErrorHandler:
    MsgBox "CopyPaste子程序出错: " & Err.Description, vbCritical
    Exit Sub
End Sub

Sub WaitForAllQueriesToFinish()
    Dim qt As QueryTable
    Dim lo As ListObject
    Dim isRefreshing As Boolean
    
    Do
        isRefreshing = False
        
        ' 检查传统QueryTable
        For Each qt In ThisWorkbook.Sheets("Data").QueryTables
            If qt.Refreshing Then
                isRefreshing = True
                Exit For
            End If
        Next qt
        
        ' 检查Power Query的ListObject（当前主流查询对象）
        If Not isRefreshing Then
            For Each lo In ThisWorkbook.Sheets("Data").ListObjects
                If lo.QueryTable Is Not Nothing And lo.QueryTable.Refreshing Then
                    isRefreshing = True
                    Exit For
                End If
            Next lo
        End If
        
        If Not isRefreshing Then Exit Do
        DoEvents ' 释放CPU资源，避免假死
    Loop
End Sub

Sub Lookup()
    On Error GoTo ErrorHandler
    
    Dim wsSource As Worksheet
    Dim wsBackup As Worksheet
    Dim lookupValue1 As Variant
    Dim lookupValue2 As Variant
    Dim i As Long
    Dim j As Long
    Dim found As Boolean
    
    Set wsSource = ThisWorkbook.Sheets("Data")
    Set wsBackup = ThisWorkbook.Sheets("Data Bk Up")
    
    Dim lastRowSource As Long
    Dim lastRowBackup As Long
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    lastRowBackup = wsBackup.Cells(wsBackup.Rows.Count, "B").End(xlUp).Row
    
    ' 遍历源表新数据，匹配备份表的手动值
    For i = 2 To lastRowSource
        lookupValue1 = wsSource.Cells(i, 2).Value
        lookupValue2 = wsSource.Cells(i, 3).Value
        found = False
        
        For j = 2 To lastRowBackup ' 从第2行开始，跳过表头
            If wsBackup.Cells(j, 2).Value = lookupValue1 And wsBackup.Cells(j, 3).Value = lookupValue2 Then
                wsSource.Cells(i, 27).Resize(, 86).Value = wsBackup.Cells(j, 27).Resize(, 86).Value
                found = True
                Exit For
            End If
        Next j
        
        If Not found Then
            wsSource.Cells(i, 27).Resize(, 86).Value = ""
        End If
    Next i
    
    Exit Sub
    
ErrorHandler:
    MsgBox "Lookup子程序出错: " & Err.Description, vbCritical
    Exit Sub
End Sub

关键修改说明 #

• 调整执行顺序：将备份数据放在刷新查询之前，确保备份的是包含手动录入值的原始数据。
• 完善等待逻辑：WaitForAllQueriesToFinish同时检查QueryTable和Power Query ListObject的刷新状态，覆盖所有常见查询类型。
• 优化Lookup循环：备份表遍历从第2行开始（跳过表头），避免无效匹配。
• 明确调用等待子程序：在刷新后、回填前强制等待所有查询完成，确保新数据完全加载。

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