Question

我正在研究一个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

Answer 1

如果还没有，请禁用查询的后台刷新（以及评估链中该查询之前的所有查询）。

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

Answer 2

如果您的连接是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

Answer 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使其不运行。我假设至少有一个您知道会改变的单元格。在那里设置目标。

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

3 个答案: