VBA小白入门之：在Excel中如何将VBA与PowerQuery结合 |
您所在的位置：网站首页 › powerquery数据整理完成后保存方式 › VBA小白入门之：在Excel中如何将VBA与PowerQuery结合 |
|
一、VBA和PowerQuery的优缺点
VBA和PowerQuery都是Excel中内置[1]的编程功能。VBA的优点在于灵活性极强，缺点在于无法进行多线程运算；而PowerQuery的优点在于按照SQL的逻辑进行的设计，因而天然地就支持“多线程”运算（更准确地讲可以视作向量运算）。为何不把二者结合起来？这样可以将开发效率和运行效率同时提高！ 二、如何利用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、更精细的操控——等刷新完毕后执行下一句在使用ListObject.QueryTable.Refresh时，VBA无法等待某个Range刷新完毕后再执行下一句。 a、粗暴的处理如果编写的程序比较简单，不需要指定刷新哪几个Range，则可以利用RefreshAll+CalculateUntilAsyncQueriesDone来实现。比如： ThisWorkBook.RefreshAll Application.CalculateUntilAsyncQueriesDone '等待所有Range刷新完后再执行下一句 MsgBox "完成！"这样，VBA会等待所有Range刷新完后再执行下一句。但是这种用法比较简单粗暴，在实践中遇到更复杂的情况时，就无法派上用场，因此一般不会用它的。 b、精细的处理通过本人在StackOverflow上查找，发现不仅ListObject.QueryTable.Refresh可以刷新PowerQuery加载到的Range，.OLEDBConnection.Refresh也可以（不明觉厉，哈哈），而且当把它的BackgroundQuery属性设置成False时，可以让当前的刷新完成后，再执行VBA中的下一句。利用这个特性，下面这个sub就可以实现等待刷新的功能： Sub RefreshSheet(RngName) 'RngName是String，是待刷新的Range的Name属性值 With ThisWorkbook.Connections("查询 - " & RngName).OLEDBConnection .BackgroundQuery = False .Refresh End With End Sub 3、性能优化——同时刷新某几张表当对于性能要求不高的时候，可以循环用上面的RefreshSheet这个Sub，在代码上做到简洁，但是这样就浪费掉了PowerQuery中的一个优秀的功能——异步刷新。所谓异步刷新，就是指充分利用缓存和多线程等机制，使得同时刷新多个Range要远快于分别顺次刷新这些Range。 在不使用VBA的时候，最常见的方式就是点击“全部刷新”，但是这样不能指定只刷新某几个Range。而若使用VBA来实现同时只刷新某几个Range的效果，则需要费一定力气。 a、主要原理将BackgroundQuery设置为True，然后利用Range("Rng1").ListObject.QueryTable.Refresh BackgroundQuery:=True或将OLEDBConnection中的BackgroundQuery设置为True后再.Refresh来启动异步刷新。 b、主要问题如何等待这些Range刷新完毕，再执行VBA的下一句？这就需要找到可以等Range刷新的VBA命令。遗憾的是，并没有直接等待Range刷新完毕的语句。Application.CalculateUntilAsyncQueriesDone会让VBA卡死，DoEvents或Sleep则会因为二者均可“阻止”PowerQuery将刷新后的表加载至Sheet中，而导致PowerQuery始终无法完成刷新，最终陷入死循环。但是，当我在调试VBA的时候发现，一旦终止VBA语句，则待刷新的Range会立刻加载到Sheet里。也就是说，DoEvents、Sleep只能是在VBA语句里等，而不能在其以外的范围内等。因此要想出一招既等又不等的方式。 c、解决办法基本思路是，首先找一个生僻字符（比如我找的字是“飝”），令待刷新的Range的.Cells(1,1).Value等于这个生僻字，第二步是开启异步刷新并令VBA结束运行，第三步当生僻字因为PowerQuery的刷新完毕而消失时，利用Workbook_Change来重新触发VBA语句，检测这些表是否均完成了刷新（即生僻字“飝”是否都消失了），第四步是若生僻字都消失了，则执行下一句，否则结束VBA的运行，等待PowerQuery继续刷新。 但是在具落笔时，遇到了一些客观的情况。 功能实现上的有： 怎么让VBA结束运行后记得住哪些表进行了刷新、后续要执行哪个sub？ 创建一个class，然后让这个class在模块内声名为Public，将刷新的表的名称、后续执行的sub的名称作为该class的一个属性装进去。 怎么让VBA去执行下一个sub？ 利用Application.Run，尽管它有一些不方便。 性能优化上的有： 如何减少Workbook_Change事件触发带来的运算量？ 在上述创建的class中，加一个属性，表示目前异步刷新的状态，如果不在进行异步刷新的话，则结束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 '表示异步刷新的状态 Set asyncRefreshRanges = CreateObject("Scripting.Dictionary") '记录待刷新的Range。当处于异步刷新时，若检测到发生变化的Range不在其中，则进行下一步操作。 asyncRefreshRanges.RemoveAll tStart = 0: tEnd = 0 '利用Timer记录起止时刻 sucMacro = "" '记录异步刷新完成后应执行哪个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是异步刷新完成后要执行哪一个sub的名称，是String类型。为空时代表着不执行，不空时，格式是“模块名.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事件触发这个方法 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：状态栏展示的样式，和程序主体无关。 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 '关闭后台刷新，减少系统资源占用 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中设置触发事件： 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：完成刷新后执行的本Workbook内的sub，不能带参数。格式写成“模块名.sub名” ' durationPrompt：是否提示异地刷新完成时间 End Sub自Office 2016起PowerQuery才完全嵌入Excel，在2013版时需要单独安装插件，在更早的版本则无法支持。 ↩ |
今日新闻 |
推荐新闻 |
| CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3 |