VBA 等待电源查询刷新以执行下一行代码
VBA Wait for refresh of power query to execute next line of code
我正在开发一个 VBA 项目，该项目需要通过电源查询更新特定的 table 作为代码的一部分。
代码功率查询刷新需要在查询继续之前完成，但是，我还没有设法找到解决方案来做到这一点。
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 刷新 table 后应该 运行 的剩余代码：
'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
这是未经测试的，但理论上它应该有效。
将您的代码分成两部分。
第一部分以刷新结束。
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
然后为了等待它完成，我们让 sub 运行 结束。
然后我们让 Excel 触发 Worksheet_Change。
在 sheet 上：
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 不成功 运行。我假设至少有一个你知道会改变的细胞。在那里设置目标。
如果您还没有禁用查询的后台刷新（以及评估链中该查询之前的任何查询）。
您需要确保未勾选后台刷新选项。我通过右键单击查询然后单击 Properties 来访问此 window。我认为在其他一些 Excel 版本中，您可能需要转至 Data > Connections，在列表中找到查询，然后在那里编辑其属性。
如果您的连接是 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
我正在开发一个 VBA 项目，该项目需要通过电源查询更新特定的 table 作为代码的一部分。 代码功率查询刷新需要在查询继续之前完成，但是，我还没有设法找到解决方案来做到这一点。
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 刷新 table 后应该 运行 的剩余代码：
'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
这是未经测试的，但理论上它应该有效。
将您的代码分成两部分。
第一部分以刷新结束。
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
然后为了等待它完成，我们让 sub 运行 结束。
然后我们让 Excel 触发 Worksheet_Change。
在 sheet 上：
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 不成功 运行。我假设至少有一个你知道会改变的细胞。在那里设置目标。
如果您还没有禁用查询的后台刷新（以及评估链中该查询之前的任何查询）。
您需要确保未勾选后台刷新选项。我通过右键单击查询然后单击 Properties 来访问此 window。我认为在其他一些 Excel 版本中，您可能需要转至 Data > Connections，在列表中找到查询，然后在那里编辑其属性。
如果您的连接是 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