等待Excel刷新全部（Ctrl+；Alt+；F5）完成-VBA

我遇到了一个竞赛条件问题，我有两个查询表，每个查询表都有自己的AfterRefresh事件。每个AfterRefresh事件都会进行一些复制粘贴以及一些计算

现在，当用户在Excel中单击Refresh All

（Ctrl+Alt+F5）

时，我希望执行每个AfterRefresh处理程序，但只有在所有查询表刷新都完全完成之后

我搜索了StackOverFlow，然后

但是，这是假设我们正在以编程方式触发重新刷新。在我的例子中，全部刷新是通过Excel中内置的全部刷新

（Ctrl+Alt+F5）

按钮完成的。因此，在我的例子中，我看不到可以在哪里插入

DoEvents

（除非我创建了自己的“刷新所有”按钮，但我希望避免这样做）

我试图搜索“Excel VBA互斥体”，但没有找到任何特别的内容。那么，如何确保在每个AfterRefresh处理程序发生之前完成所有刷新

谢谢你的阅读

更新：帮助调试。。这是我的VBA代码

我有一个名为

AutoOpen

Dim S As New DataCopy
Dim U As New DataCopy

Sub Auto_Open()
    Set S.qt = ThisWorkbook.Sheets(1).QueryTables(2)
    S.myWorkbookName = ThisWorkbook.Name
    S.sWorksheetProcessName = "ProcessS"
    S.sWorksheetDataColumnStart = 1
    S.sWorksheetDataColumnEnd = 5
    Set U.qt = ThisWorkbook.Sheets(1).QueryTables(1)
    U.myWorkbookName = ThisWorkbook.Name
    U.sWorksheetProcessName = "ProcessU"
    U.sWorksheetDataColumnStart = 6
    U.sWorksheetDataColumnEnd = 10
End Sub

我还有一个名为

DataCopy

Public WithEvents qt As QueryTable
Public myWorkbookName As String
Public sWorksheetProcessName As String
Public sWorksheetDataColumnStart As Integer
Public sWorksheetDataColumnEnd As Integer

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
    DataCopier
End Sub

Private Sub DataCopier()
    'Debug.Print sWorksheetProcessName & "," & Application.CalculationState
    Dim LastNRows As Integer
    Dim sWorksheetDataName As String

    ' How many rows to copy
    LastNRows = 297
    sWorksheetDataName = "Data"

    Application.ScreenUpdating = False

    ' Clear content in process tab
    With Workbooks(myWorkbookName).Worksheets(sWorksheetProcessName)
        .Range(.Cells(4, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 6)).ClearContents
    End With

    ' Copy to process Tab
    With Workbooks(myWorkbookName).Worksheets(sWorksheetDataName)
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        FirstRow = LastRow - LastNRows
        If FirstRow < 2 Then
            FirstRow = 2
        End If
        .Range(.Cells(FirstRow, sWorksheetDataColumnStart), .Cells(LastRow, sWorksheetDataColumnEnd)).Copy _
             Destination:=Workbooks(myWorkbookName).Worksheets(sWorksheetProcessName).Range("A4")
    End With

    Debug.Print (sWorksheetProcessName & "," & sWorksheetDataColumnStart & "," & sWorksheetDataColumnEnd)

    Application.ScreenUpdating = True
End Sub

Public，事件qt作为查询表
公共myWorkbookName作为字符串
Public sWorksheetProcessName作为字符串
Public sWorksheetDataColumnStart为整数
Public sworksheetdata columnEnd为整数
刷新后的私有子qt_（ByVal Success作为布尔值）
数据复印机
端接头
专用子数据复制器（）
'Debug.Print工作表进程名&“，”&应用程序.CalculationState
将LastNRows设置为整数
Dim sWorksheetDataName作为字符串
'要复制多少行
LastNRows=297
sworksheetdata=“数据”
Application.ScreenUpdating=False
'清除进程中的内容选项卡
带有工作簿（myWorkbookName）。工作表（工作表进程名）
.Range（.Cells（4,1），.Cells（.Cells（Rows.Count，1）.End（xlUp）.Row，6））.ClearContents
以
'复制到进程选项卡
使用工作簿（myWorkbookName）。工作表（工作表数据名）
LastRow=.Cells（Rows.Count，1）.End（xlUp）.Row
第一行=最后一行-最后一行
如果第一行小于2，则
第一行=2
如果结束
.Range（.Cells（第一行，sWorksheetDataColumnStart）、.Cells（最后一行，sworksheetdatacolumnsend））.Copy_
目标：=工作簿（myWorkbookName）.工作表（工作表进程名）.范围（“A4”）
以
Debug.Print（sWorksheetProcessName&“，”&sWorksheetDataColumnStart&“，”&sworksheetdatacolumnsend）
Application.ScreenUpdating=True
端接头

---

由于竞争条件，只有一个AfterRefresh处理程序成功复制粘贴。。另一个在我再次单击“刷新全部”按钮（Ctrl+Alt+F5）之前不起作用

将查询更改为不允许后台刷新，并且在刷新之前不会放弃控制

---

如果

DoEvents

在显式VBA触发器

Activeworkbook.RefreshAll

之后工作，则要在事件处理程序中运行的代码之前的

DoEvents

应涵盖由

Ctrl+Alt+F5

触发刷新的情况。因此，每个事件处理程序都以行

DoEvents

开始，也许每个

AfterRefresh

事件处理程序都可以以

Activeworkbook结束。RefreshAll

后跟

DoEvents

，可能带有一些切换布尔公共变量以防止事件回音。@JohnColeman，但是用户已经单击了内置的“全部刷新”按钮，所以如果我向每个

AfterRefresh

添加

Activeworkbook.RefreshAll

，这不意味着它实际上是刷新两次吗？实际上，仔细想想，由于它在刷新后的

内，它会触发刷新中的无限循环吗？因为
AfterRefresh
会触发另一次刷新，从而触发
AfterRefresh
againI现在可以更清楚地看到问题了。可能在每个事件处理程序的开头包含一个计时器循环，循环体中包含一个
DoEvents
。每个事件处理程序都可以在允许刷新完成时暂停几秒钟。它甚至可以简单到在每个处理程序的开头包含一个
DoEvents
。因为Excel并不是真正为多线程而设计的，所以您需要一些混乱。而且--我现在不记得是什么了，因为我曾经遇到过一种情况，需要两个
DoEvents
连成一行。作为一个实验，从两个方面开始2@JohnColeman谢谢我会试试看。然后回来报到。竞态条件的问题在于复制并不总是一致的。幸运的是，它的重复性是10次中的9次。@JohnColeman
DoEvents
似乎已经做到了这一点。我只是在刷新后插入了
qt\u
请随意提交，作为回答这是可以从连接属性UI中完成的吗？或者这只是在VBA中完成的？因为如果它在代码中，我不知道我是否需要在逻辑上投资来检查它是否已经设置为False。虽然到目前为止，DoEvents似乎能做到这一点，但我也会试试你的。添加了在哪里可以找到背景刷新选项的图片。我明白为什么你有这个选项，而我没有，因为我的外部源只是两个不断更新的CSV文件，而不是SQL连接。请进一步解释你的解决方案。恐怕我不明白。
Public WithEvents qt As QueryTable
Public myWorkbookName As String
Public sWorksheetProcessName As String
Public sWorksheetDataColumnStart As Integer
Public sWorksheetDataColumnEnd As Integer

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
    DataCopier
End Sub

Private Sub DataCopier()
    'Debug.Print sWorksheetProcessName & "," & Application.CalculationState
    Dim LastNRows As Integer
    Dim sWorksheetDataName As String

    ' How many rows to copy
    LastNRows = 297
    sWorksheetDataName = "Data"

    Application.ScreenUpdating = False

    ' Clear content in process tab
    With Workbooks(myWorkbookName).Worksheets(sWorksheetProcessName)
        .Range(.Cells(4, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 6)).ClearContents
    End With

    ' Copy to process Tab
    With Workbooks(myWorkbookName).Worksheets(sWorksheetDataName)
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        FirstRow = LastRow - LastNRows
        If FirstRow < 2 Then
            FirstRow = 2
        End If
        .Range(.Cells(FirstRow, sWorksheetDataColumnStart), .Cells(LastRow, sWorksheetDataColumnEnd)).Copy _
             Destination:=Workbooks(myWorkbookName).Worksheets(sWorksheetProcessName).Range("A4")
    End With

    Debug.Print (sWorksheetProcessName & "," & sWorksheetDataColumnStart & "," & sWorksheetDataColumnEnd)

    Application.ScreenUpdating = True
End Sub