VBA小白入門之：在Excel中如何將VBA與PowerQuery結合

一、VBA和PowerQuery的優(yōu)缺點

VBA和PowerQuery都是Excel中內置[1]的編程功能。VBA的優(yōu)點在于靈活性極強，缺點在于無法進行多線程運算；而PowerQuery的優(yōu)點在于按照SQL的邏輯進行的設計，因而天然地就支持“多線程”運算（更準確地講可以視作向量運算）。為何不把二者結合起來？這樣可以將開發(fā)效率和運行效率同時提高！

二、如何利用VBA操縱PowerQuery

常用的方式是將PowerQuery的查詢加載到某個Sheet中的Table/Range（在PowerQuery看來是Table，在VBA看來是Range），然后通過某種方式操縱PowerQuery的刷新動作。下面講的內容均是如何利用VBA來刷新某個連接到PowerQuery的Table/Range。

1、基本操作

刷新單個Range

Range("Rng1").ListObject.QueryTable.Refresh BackgroundQuery:=False
'Rng是待刷新Range的Name屬性

刷新所有Range

ThisWorkbook.RefreshAll

2、更精細的操控——等刷新完畢后執(zhí)行下一句

在使用ListObject.QueryTable.Refresh時，VBA無法等待某個Range刷新完畢后再執(zhí)行下一句。

a、粗暴的處理

如果編寫的程序比較簡單，不需要指定刷新哪幾個Range，則可以利用RefreshAll+CalculateUntilAsyncQueriesDone來實現。比如：

ThisWorkBook.RefreshAll
Application.CalculateUntilAsyncQueriesDone
'等待所有Range刷新完后再執(zhí)行下一句
MsgBox "完成！"

這樣，VBA會等待所有Range刷新完后再執(zhí)行下一句。但是這種用法比較簡單粗暴，在實踐中遇到更復雜的情況時，就無法派上用場，因此一般不會用它的。

b、精細的處理

通過本人在StackOverflow上查找，發(fā)現不僅ListObject.QueryTable.Refresh可以刷新PowerQuery加載到的Range，.OLEDBConnection.Refresh也可以（不明覺厲，哈哈），而且當把它的BackgroundQuery屬性設置成False時，可以讓當前的刷新完成后，再執(zhí)行VBA中的下一句。利用這個特性，下面這個sub就可以實現等待刷新的功能：

Sub RefreshSheet(RngName)
'RngName是String，是待刷新的Range的Name屬性值
    With ThisWorkbook.Connections("查詢 - " & RngName).OLEDBConnection
        .BackgroundQuery = False
        .Refresh
    End With
End Sub

3、性能優(yōu)化——同時刷新某幾張表

當對于性能要求不高的時候，可以循環(huán)用上面的RefreshSheet這個Sub，在代碼上做到簡潔，但是這樣就浪費掉了PowerQuery中的一個優(yōu)秀的功能——異步刷新。所謂異步刷新，就是指充分利用緩存和多線程等機制，使得同時刷新多個Range要遠快于分別順次刷新這些Range。

在不使用VBA的時候，最常見的方式就是點擊“全部刷新”，但是這樣不能指定只刷新某幾個Range。而若使用VBA來實現同時只刷新某幾個Range的效果，則需要費一定力氣。

a、主要原理

將BackgroundQuery設置為True，然后利用Range("Rng1").ListObject.QueryTable.Refresh BackgroundQuery:=True或將OLEDBConnection中的BackgroundQuery設置為True后再.Refresh來啟動異步刷新。

b、主要問題

如何等待這些Range刷新完畢，再執(zhí)行VBA的下一句？這就需要找到可以等Range刷新的VBA命令。遺憾的是，并沒有直接等待Range刷新完畢的語句。Application.CalculateUntilAsyncQueriesDone會讓VBA卡死，DoEvents或Sleep則會因為二者均可“阻止”PowerQuery將刷新后的表加載至Sheet中，而導致PowerQuery始終無法完成刷新，最終陷入死循環(huán)。但是，當我在調試VBA的時候發(fā)現，一旦終止VBA語句，則待刷新的Range會立刻加載到Sheet里。也就是說，DoEvents、Sleep只能是在VBA語句里等，而不能在其以外的范圍內等。因此要想出一招既等又不等的方式。

c、解決辦法

基本思路是，首先找一個生僻字符（比如我找的字是“飝”），令待刷新的Range的.Cells(1,1).Value等于這個生僻字，第二步是開啟異步刷新并令VBA結束運行，第三步當生僻字因為PowerQuery的刷新完畢而消失時，利用Workbook_Change來重新觸發(fā)VBA語句，檢測這些表是否均完成了刷新（即生僻字“飝”是否都消失了），第四步是若生僻字都消失了，則執(zhí)行下一句，否則結束VBA的運行，等待PowerQuery繼續(xù)刷新。

但是在具落筆時，遇到了一些客觀的情況。

功能實現上的有：

  • 怎么讓VBA結束運行后記得住哪些表進行了刷新、后續(xù)要執(zhí)行哪個sub？

    創(chuàng)建一個class，然后讓這個class在模塊內聲名為Public，將刷新的表的名稱、后續(xù)執(zhí)行的sub的名稱作為該class的一個屬性裝進去。

  • 怎么讓VBA去執(zhí)行下一個sub？

    利用Application.Run，盡管它有一些不方便。

性能優(yōu)化上的有：

  • 如何減少Workbook_Change事件觸發(fā)帶來的運算量？

    在上述創(chuàng)建的class中，加一個屬性，表示目前異步刷新的狀態(tài)，如果不在進行異步刷新的話，則結束Worksheet_Change這個sub。

  • 如何減少異步刷新的內存及CPU占用，從而進一步強化性能？

    在檢測到某個Range已經加載完畢后，立刻將“它”的BackgroundQuery屬性設為False。因為若仍然保留True，則似乎會占用很大的內存和CPU，就像打開了允許數據后臺刷新的功能一樣；及時設置為False后，內存和CPU的占用會大大改善。

d、具體代碼

將以下代碼打包了一個類：ayncRefreshThr

Private isRefreshing As Boolean, asyncRefreshRanges As Object
Private tStart, tEnd As Double, sucMacro As String, asyncN As Long
Private durationPmpt As Boolean

Private Sub Class_Initialize()
  isRefreshing = False '表示異步刷新的狀態(tài)
  Set asyncRefreshRanges = CreateObject("Scripting.Dictionary")
  '記錄待刷新的Range。當處于異步刷新時，若檢測到發(fā)生變化的Range不在其中，則進行下一步操作。
  asyncRefreshRanges.RemoveAll
  tStart = 0: tEnd = 0 '利用Timer記錄起止時刻
  sucMacro = "" '記錄異步刷新完成后應執(zhí)行哪個sub
  durationPmpt = False '異步刷新完成時是否提示用了多長時間
  asyncN = 0 '一共有幾個Range待刷新
End Sub

Sub asyncRefresh(rngArr, Optional macroStr = "", Optional durationPrompt = False, Optional singleThdebug As Boolean = False)
' rngArr：是Array，其中每個元素均是String，是待刷新表的Name
' macroStr是異步刷新完成后要執(zhí)行哪一個sub的名稱，是String類型。為空時代表著不執(zhí)行，不空時，格式是“模塊名.sub名”
' singleThdebug用于控制是否使用異步刷新的方式批量刷新一批Range。僅在調試中使用。
Dim i As Integer, tmpstr1, tmpstr2 As String
  If singleThdebug Then
  '一個一個Range地刷，不采用異步刷新。此處僅供調試用。
      If Len(macroStr) <> 0 Then sucMacro = ThisWorkbook.Name & "!" & CStr(macroStr) 'Application.Run其實還要在前面補上工作簿的名稱，但是因為肯定是自己內部引用，所以在設計函數時省略，并于此處自動補充上。
      For Each itm In rngArr
          RefreshSheet itm
      Next itm
      If Len(sucMacro) <> 0 Then Application.Run sucMacro
  Else '異步刷新的開始
      tStart = Timer
      durationPmpt = CBool(durationPrompt)
      If Len(macroStr) <> 0 Then sucMacro = ThisWorkbook.Name & "!" & CStr(macroStr)
          For i = 1 To arrLen(rngArr)
          tmpstr1 = CStr(rngArr(LBound(rngArr) + i - 1))
          If Not asyncRefreshRanges.exists(tmpstr1) Then
              asyncRefreshRanges.Add tmpstr1, ""
          End If
      Next i

      '打上生僻字標記
      For Each itm In asyncRefreshRanges.keys
          Range(itm).Cells(1, 1).Value = "飝"
      Next itm

      isRefreshing = True
      For Each itm In asyncRefreshRanges.keys
          Range(itm).ListObject.QueryTable.Refresh BackgroundQuery:=True
      Next itm
      asyncN = asyncRefreshRanges.Count
      Application.StatusBar = "正在異步刷新（0/" & asyncN & "）：" & Join(asyncRefreshRanges.keys, "、")
  End If
End Sub

Sub checkStatus() '讓Workbook_Change事件觸發(fā)這個方法
  If isRefreshing Then
      If asyncRefreshOver() Then
          isRefreshing = False: tEnd = Timer
          If durationPmpt Then MsgBox "刷新用時：" & Format(tEnd - tStart, "0.00秒"), vbInformation, "異步刷新完成"
          If Len(sucMacro) <> 0 Then Application.Run sucMacro
      End If
  End If
End Sub

Private Function asyncRefreshOver(Optional statusBarStyle = "live") As Boolean
'statusBarStyle：狀態(tài)欄展示的樣式，和程序主體無關。
Dim n As Integer, isOver As Boolean
  If isRefreshing = False Then
      asyncRefreshOver = True
  Else
      isOver = True
      Select Case statusBarStyle
          Case "process"
              For Each itm In asyncRefreshRanges.keys
                  n = 0 '待累加量，表示有多少個Range完成了刷新
                  If asyncRefreshRanges.Item(itm) = "ok" Then
                      'isOver = isOver And True
                      n = n + 1
                  ElseIf Range(itm).Cells(1, 1) = "飝" Then
                      isOver = False
                  Else
                      asyncRefreshRanges.Item(itm) = "ok"
                      Range(itm).ListObject.QueryTable.BackgroundQuery = False '關閉后臺刷新，減少系統(tǒng)資源占用
                      n = n + 1
                  End If
              Next itm
              Application.StatusBar = "正在異步刷新（" & n & "/" & asyncN & "）：" & Join(asyncRefreshRanges.keys, "、")
          Case "live"
              For Each itm In asyncRefreshRanges.keys
                  If Range(itm).Cells(1, 1) = "飝" Then
                      isOver = False
                  Else
                      asyncRefreshRanges.Remove (itm)
                      Range(itm).ListObject.QueryTable.BackgroundQuery = False
                  End If
              Next itm
              Application.StatusBar = "正在異步刷新（" & (asyncN - asyncRefreshRanges.Count) & "/" & asyncN & "）：" & Join(asyncRefreshRanges.keys, "、")
          Case Else
              isOver = True
      End Select

      If isOver Then
          'MsgBox "刷新完畢！"
          isRefreshing = False
          asyncRefreshRanges.RemoveAll
          Application.StatusBar = False
      End If
      asyncRefreshOver = isOver
  End If
End Function

Private Function arrLen(arr) As Long
  arrLen = UBound(arr) - LBound(arr) + 1
End Function

Private Sub RefreshSheet(RngName) 'RngName是String，是待刷新的Range的Name屬性值
  With ThisWorkbook.Connections("查詢 - " & RngName).OLEDBConnection
      .BackgroundQuery = False
      .Refresh
  End With
End Sub

在Workbook中設置觸發(fā)事件：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    aRefreshT1.checkStatus
End Sub

在一般的模塊中寫：

Public aRefreshT1 As New ayncRefreshThr

Sub RefreshSheets(rngArr, Optional macro = "", Optional durationPrompt As Boolean = False)
    aRefreshT1.asyncRefresh rngArr, macro, durationPrompt
    ' rngArr：是Array，其中每個元素是String，表示待刷新Range的Name
    ' macro：完成刷新后執(zhí)行的本Workbook內的sub，不能帶參數。格式寫成“模塊名.sub名”
    ' durationPrompt：是否提示異地刷新完成時間
End Sub

  1. 自Office 2016起PowerQuery才完全嵌入Excel，在2013版時需要單獨安裝插件，在更早的版本則無法支持。 ?

最后編輯于 ：
?著作權歸作者所有,轉載或內容合作請聯系作者
【社區(qū)內容提示】社區(qū)部分內容疑似由AI輔助生成，瀏覽時請結合常識與多方信息審慎甄別。
平臺聲明：文章內容（如有圖片或視頻亦包括在內）由作者上傳并發(fā)布，文章內容僅代表作者本人觀點，簡書系信息發(fā)布平臺，僅提供信息存儲服務。

相關閱讀更多精彩內容

友情鏈接更多精彩內容