如何让VBA脚本等待所有CUBEVALUE函数完成重算？

原代码依赖Application.CalculationState = xlDone无法准确识别OLAP函数（如CUBEVALUE）的查询完成状态——这类函数的OLAP查询是独立于Excel常规计算引擎的异步操作，因此需要针对性检查查询连接的状态。

以下是几种修改方案，可根据你的CUBEVALUE使用场景选择：

方案1：检查所有QueryTable刷新状态 #

若CUBEVALUE通过QueryTable绑定OLAP数据源，使用此代码：

Sub WaitForCubeQueriesComplete()
    Dim qt As QueryTable
    Dim waittime As Integer
    waittime = 0
    
    ' 等待所有QueryTables完成刷新
    Do
        Application.Wait Now + TimeValue("0:00:01")
        waittime = waittime + 1
        ' 遍历检查每个QueryTable的刷新状态
        For Each qt In ThisWorkbook.QueryTables
            If qt.Refreshing Then Exit For
        Next qt
    Loop Until qt Is Nothing ' 所有QueryTable都未在刷新时退出循环
    
    ' 额外确认常规计算完成
    Do Until Application.CalculationState = xlDone
        Application.Wait Now + TimeValue("0:00:01")
        waittime = waittime + 1
    Loop
    
    Debug.Print "等待时长: " & waittime & "秒"
End Sub

方案2：检查结构化表（ListObject）的刷新状态 #

若CUBEVALUE通过结构化表（ListObject）关联OLAP数据源，使用此代码：

Sub WaitForCubeListObjectsComplete()
    Dim lo As ListObject
    Dim waittime As Integer
    waittime = 0
    
    ' 等待所有ListObjects完成刷新
    Do
        Application.Wait Now + TimeValue("0:00:01")
        waittime = waittime + 1
        ' 遍历检查每个结构化表的QueryTable状态
        For Each lo In ThisWorkbook.Worksheets.ListObjects
            If lo.QueryTable.Refreshing Then Exit For
        Next lo
    Loop Until lo Is Nothing
    
    ' 确认常规计算完成
    Do Until Application.CalculationState = xlDone
        Application.Wait Now + TimeValue("0:00:01")
        waittime = waittime + 1
    Loop
    
    Debug.Print "等待时长: " & waittime & "秒"
End Sub

方案3：直接检查OLAP连接状态 #

若CUBEVALUE直接引用OLAP Cube连接，使用此代码精准检测连接的刷新状态：

Sub WaitForCubeConnectionsComplete()
    Dim conn As WorkbookConnection
    Dim cubeConn As CubeConnection
    Dim isRefreshing As Boolean
    Dim waittime As Integer
    waittime = 0
    
    Do
        isRefreshing = False
        Application.Wait Now + TimeValue("0:00:01")
        waittime = waittime + 1
        
        ' 遍历所有工作簿连接，检查OLAP类型连接的刷新状态
        For Each conn In ThisWorkbook.Connections
            If conn.Type = xlConnectionTypeOLAP Then
                Set cubeConn = conn.OLEDBConnection.CubeConnection
                If cubeConn.IsRefreshing Then
                    isRefreshing = True
                    Exit For
                End If
            End If
        Next conn
    Loop While isRefreshing ' 存在正在刷新的OLAP连接则继续等待
    
    ' 确认常规计算完成
    Do Until Application.CalculationState = xlDone
        Application.Wait Now + TimeValue("0:00:01")
        waittime = waittime + 1
    Loop
    
    Debug.Print "等待时长: " & waittime & "秒"
End Sub

补充说明 #

• 将等待间隔从2秒改为1秒，可更及时地检测完成状态，减少冗余等待。
• 若仅需检查特定连接/QueryTable，可修改代码指定目标对象，提升运行效率。

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