VBA 等待刷新电源查询以执行下一行代码

Posted 2023-02-22

【中文标题】VBA 等待刷新电源查询以执行下一行代码

【英文标题】：VBA Wait for refresh of power query to execute next line of code

【发布时间】：2019-04-21 22:33:26

【问题描述】：

我正在开发一个 VBA 项目，该项目需要通过电源查询更新特定表作为代码的一部分。 代码电源查询刷新需要在查询继续之前完成，但是，我还没有找到解决方案。

Option Explicit
Option Base 1


Public Sub LoadProductsForecast()

我已经插入了几个步骤来优化性能

'Deactivate global application parameters to optimise code performance
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False


'Dimensions used in code for sheets etc.
Dim lastrow As Integer
Dim NoRowsInitial As Integer


''''''''''''''''''''''
''Get product data, and copy index match formula to look up the forecast

' find number of rows to use for clearing
NoRowsInitial = WorksheetFunction.CountA(Worksheets("Monthly Forecast").Range("D4:D15000"))

'Selecting Worksheet w. product master data
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = Sheets("Products")
wb.Activate
ws.Select

下一行是我希望刷新电源查询的地方，刷新部分可以正常工作。 但是，它将继续运行下一个 VBA 代码。我在网上搜索了不同的答案，有些提到“DoEvents”，但是，它似乎没有什么不同。

ActiveWorkbook.Connections("Query - tblAdjustments").Refresh
DoEvents

下面是 PowerQuery 刷新表后应该运行的剩余代码：

'Calculating number of rows to copy
lastrow = WorksheetFunction.CountA(Worksheets("Products").Range("B4:B15000"))

'Copying rows
Worksheets("Products").Range(Cells(4, 2), Cells(lastrow + 3, 10)).Copy

'Selecring forecast sheet
Set ws = Sheets("Monthly Forecast")
ws.Select

'Disabling alerts, so pop up for pasting data does not show (activated again later)
Application.DisplayAlerts = False

'Pasting product master data
Worksheets("Monthly Forecast").Range(Cells(8, 4), Cells(lastrow, 12)).PasteSpecial


'Creating a string that contains range to paste formula in to
Dim RangeString As String
RangeString = "N8:W" & lastrow + 7

'Copying formula to paste
    Range("AJ2:AJ3").Select
    Selection.Copy

'Pasting formula that looks up baseline FC (both seasonal and SES)
    Range(RangeString).Select
    ActiveSheet.Paste

Calculate

With Range(RangeString)
    .Value = .Value
End With

'Activating alerts again
Application.DisplayAlerts = True



''''''''''''''''''''''
''Code to clean the rows that are not used
'Remove unescessary rows


Dim NPIProducts As Integer
NPIProducts = [tblNewProd].Rows.Count


'tbl.Range.Rows.Count



Dim RowsToDelete As String

RowsToDelete = lastrow + NPIProducts * 2 & ":" & NoRowsInitial

If Left(RowsToDelete, 1) = "-" Then
    'do nothing (negative)
Else
    [tblMonthly].Rows(RowsToDelete).Delete
End If


'''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''
''''End of main code

'Activate global application parameters again
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True


'Messages end user that the calculation is done
MsgBox "Load of products and forecast finished"

End Sub

【问题讨论】：

如果您真的只需要 vba 在查询刷新时稍等片刻，您可以尝试简单调用应用程序的 wait 方法。例如，将其放在查询刷新行下方会导致代码等待 10 秒：Call Application.Wait(Now + TimeValue("0:00:10"))

我需要它是动态的，因为查询需要经常运行，并且数据量（因此数据刷新时间）会有很大差异。

您的连接是 OLEDB 还是 ODBC？

【参考方案1】：

如果您的连接是 OLEDB 或 ODBC，您可以将后台刷新临时设置为 false - 强制在代码继续运行之前进行刷新。而不是调用

.Connections("Query - tblAdjustments").Refresh

做这样的事情：

Dim bRfresh As Boolean

    With ThisWorkbook.Connections("Query - tblAdjustments").OLEDBConnection
        bRfresh = .BackgroundQuery
        .BackgroundQuery = False
        .Refresh
        .BackgroundQuery = bRfresh

    End With

此示例假设您有一个 OLEDB 连接。如果您有 ODBC，只需将 OLEDBConnection 替换为 ODBCConnection

【讨论】：

当 Power Query 将数据加载到 Excel 中的表中时，它通过在自身和表之间设置 OLE DB 连接来实现。因此，作为使用 Power Query 刷新和宏的一般规则，这是您想要处理的方式。

【参考方案2】：

如果您尚未禁用查询的后台刷新（以及评估链中该查询之前的任何查询）。

您需要确保未勾选后台刷新选项。我通过右键单击查询然后单击Properties 访问此窗口。我认为在其他一些 Excel 版本中，您可能需要转到 Data > Connections，在列表中找到查询，然后在那里编辑其属性。

【参考方案3】：

这是未经测试的，但理论上它应该可以工作。 将您的代码分成两部分。

第一部分以刷新结束。

sub some_sub()  
    'Deactivate global application parameters to optimise code performance
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayStatusBar = False


    'Dimensions used in code for sheets etc.
    Dim lastrow As Integer
    Dim NoRowsInitial As Integer


    ''''''''''''''''''''''
    ''Get product data, and copy index match formula to look up the forecast

    ' find number of rows to use for clearing
    NoRowsInitial = WorksheetFunction.CountA(Worksheets("Monthly Forecast").Range("D4:D15000"))

    'Selecting Worksheet w. product master data
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ActiveWorkbook
    Set ws = Sheets("Products")
    wb.Activate
    ws.Select
    ActiveWorkbook.Connections("Query - tblAdjustments").Refresh
end sub

然后为了等待它完成，我们让子运行结束。

然后我们让 Excel 触发 Worksheet_Change。 在工作表上：

Private Sub Worksheet_Change(ByVal Target As Range)


 'Calculating number of rows to copy
    lastrow = WorksheetFunction.CountA(Worksheets("Products").Range("B4:B15000"))

    'Copying rows
    Worksheets("Products").Range(Cells(4, 2), Cells(lastrow + 3, 10)).Copy

    'Selecring forecast sheet
    Set ws = Sheets("Monthly Forecast")
    ws.Select

    'Disabling alerts, so pop up for pasting data does not show (activated again later)
    Application.DisplayAlerts = False

    'Pasting product master data
    Worksheets("Monthly Forecast").Range(Cells(8, 4), Cells(lastrow, 12)).PasteSpecial


    'Creating a string that contains range to paste formula in to
    Dim RangeString As String
    RangeString = "N8:W" & lastrow + 7

    'Copying formula to paste
        Range("AJ2:AJ3").Select
        Selection.Copy

    'Pasting formula that looks up baseline FC (both seasonal and SES)
        Range(RangeString).Select
        ActiveSheet.Paste

    Calculate

    With Range(RangeString)
        .Value = .Value
    End With

    'Activating alerts again
    Application.DisplayAlerts = True



    ''''''''''''''''''''''
    ''Code to clean the rows that are not used
    'Remove unescessary rows


    Dim NPIProducts As Integer
    NPIProducts = [tblNewProd].Rows.Count


    'tbl.Range.Rows.Count



    Dim RowsToDelete As String

    RowsToDelete = lastrow + NPIProducts * 2 & ":" & NoRowsInitial

    If Left(RowsToDelete, 1) = "-" Then
        'do nothing (negative)
    Else
        [tblMonthly].Rows(RowsToDelete).Delete
    End If


    '''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''
    '''''''''''''''''''''''''''''''''''''''''''''
    ''''End of main code

    'Activate global application parameters again
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True


    'Messages end user that the calculation is done
    MsgBox "Load of products and forecast finished"
End Sub

如果你不想让它运行，你可以使用 Target 让它不运行。我假设至少有一个你知道会改变的单元格。在那里设定目标。