Excel VBA在单元格中显示立即窗口的结果

我有一个macros,每个查询需要多长时间运行,并输出到立即窗口的时间。

我有一种方法来设置它输出到单元格?

macros:

Sub TimeQueries() Dim oSh As Worksheet Dim oCn As WorkbookConnection Dim dTime As Double For Each oCn In ThisWorkbook.Connections dTime = Timer oCn.Ranges(1).ListObject.QueryTable.Refresh False Debug.Print Timer - dTime, oCn.Name, oCn.Ranges(1).Address(external:=True) Next End Sub 

立即窗口输出:

  6.609375 Query1 [YEtest.xlsm]Query1!$A$1:$S$3006 15.12109375 Query2 [YEtest.xlsm]Query2!$A$1:$S$3006 21.0703125 Query3 [YEtest.xlsm]Query3!$A$1:$S$3006 0.125 Query4 [YEtest.xlsm]Query4!$A$1:$B$2 

标签名称我希望它输出到: Control

只需将oSh设置为工作表参考,并使用Cells集合输出您想要的内容:

 Sub TimeQueries() Dim oSh As Worksheet Dim oCn As WorkbookConnection Dim dTime As Double Dim lngCounter As Long 'set a worksheet reference - eg Sheet1 Set oSh = ThisWorkbook.Worksheets("Control") 'initialise counter lngCounter = 1 For Each oCn In ThisWorkbook.Connections dTime = Timer oCn.Ranges(1).ListObject.QueryTable.Refresh False 'set output to cells on the worksheet oSh.Cells(lngCounter, 1).Value = Timer - dTime oSh.Cells(lngCounter, 2).Value = oCn.Name oSh.Cells(lngCounter, 3).Value = oCn.Ranges(1).Address(external:=True) lngCounter = lngCounter + 1 'Debug.Print Timer - dTime, oCn.Name, oCn.Ranges(1).Address(external:=True) Next End Sub 
 Sub TimeQueries() Dim oSh As Worksheet Dim oCn As WorkbookConnection Dim dTime As Double Dim rw As Long rw = 1 For Each oCn In ThisWorkbook.Connections rw = rw + 1 dTime = Timer oCn.Ranges(1).ListObject.QueryTable.Refresh False With Sheets("Control") .Cells(rw, 1) = Timer - dTime .Cells(rw, 2) = oCn.Name .Cells(rw, 3) = oCn.Ranges(1).Address(external:=True) End With Next End Sub 

这应该工作:

 Sub TimeQueries() Dim oSh As Worksheet Dim oCn As WorkbookConnection Dim dTime As Double 'define first output range Dim rng as Range Set rng = ThisWorkbook.Worksheets("Control").Range("A1:C1") 'change as necessary For Each oCn In ThisWorkbook.Connections dTime = Timer oCn.Ranges(1).ListObject.QueryTable.Refresh False 'output to defined range and then redefine rng to the row below rng.Value = Array(Timer - dTime, oCn.Name, oCn.Ranges(1).Address (external:=True)) Set rng = rng.Offset(1,0) Next End Sub