记录集导致 Excel 没有响应
Recordset causing Excel togo Not Responding
我不知道为什么 运行 在 10-11 秒内直接导致 Excel 停止响应的查询。即使是只有 193 行 x 26 列的此查询的更多过滤版本也会导致同样的问题。
按顺序启用的引用：
- VB 应用
- MS Excel 16.0 对象库
- OLE 自动化
- MS Office 16.0 对象库
- MS ActiveX 数据对象 6.1 库
- MS Forms 2.0 对象库
- MS ActiveX 数据对象 Recordset 2.8 库（也试过 6.0 以防万一）
我正在尝试为记录集创建一个查询表以将数据转储到：
Option Explicit
Sub Import_Data()
On Error GoTo ErrorHandler
Dim BCS As Worksheet
Dim dv As Worksheet
Dim RegAtt As Worksheet
Dim POData As Worksheet
Dim CARData As Worksheet
Dim UserDefinedFilters As String
Dim POFilters As String
Dim Site_List As String
Dim CL As String
Dim FL As String
Dim scenario_year As Integer
Dim Scenario As String
Dim RegSql As String
Dim POSql1 As String
Dim POSql2 As String
Dim POSql3 As String
Dim BCSSql1 As String
Dim BCSSql2 As String
Dim BCSSql3 As String
Dim BCSSql4 As String
Dim CS As String
Dim CS64 As String
Dim CS32 As String
Dim response As String
Dim con As ADODB.Connection
Dim Rs As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim qt As Variant
Dim qt2 As Variant
Dim qt3 As Variant
Dim hdrs As Variant
Dim i As Variant
Set con = New ADODB.Connection
Set rs3 = CreateObject("ADODB.RECORDSET")
Call DeleteConnections
'Test for Mac
#If Mac Then
'if Mac then use this driver
CS = "Driver={Amazon Redshift};SERVER={<rs>};UID=<user>;PASSWORD=<pwd>;DATABASE=<db>;PORT=8192"
#ElseIf Win64 Then
CS64 = "Driver={Amazon Redshift (x64)};SERVER={<rs>};UID=<user>;PASSWORD=<pwd>;DATABASE=<db>;PORT=8192"
con.Open CS64
#Else
CS32 = "Driver={Amazon Redshift (x86)};SERVER={<rs>};UID=<user>;PASSWORD=<pwd>;DATABASE=<db>;PORT=8192"
con.Open CS32
#End If
Application.ScreenUpdating = False
'Filter Fields
Site_List = UCase(ThisWorkbook.Sheets(Sheet1.Name).Range("D1").Value)
CL = UCase(ThisWorkbook.Sheets(Sheet1.Name).Range("D2").Value)
FL = UCase(ThisWorkbook.Sheets(Sheet1.Name).Range("D3").Value)
scenario_year = ThisWorkbook.Sheets(Sheet1.Name).Range("D4").Value
Scenario = "'" & ThisWorkbook.Sheets(Sheet1.Name).Range("D5").Value & "'"
'POData Filters
If CL <> "" And FL <> "" Then
CL = Replace(CL, ", ", ",")
FL = Replace(FL, ", ", ",")
POFilters = POFilters & "UPPER(LEFT(po.po_fbn,3)) in ('" & Replace(CL, ",", "','") & "') " & _
vbNewLine & " AND UPPER(po.po_bn) in ('" & Replace(FL, ",", "','") & "') "
ElseIf CL <> "" And FL = "" Then
CL = Replace(CL, ", ", ",")
POFilters = POFilters & "UPPER(LEFT(po.po_bn,3)) in ('" & Replace(CL, ",", "','") & "') "
ElseIf CL = "" And FL <> "" Then
If InStr(1, FBNList, ",") > 0 Then
FL = Replace(FL, ", ", ",")
POFilters = POFilters & " UPPER(po.po_bn) in ('" & Replace(UCase(FL), ",", "','") & "') "
ElseIf InStr(1, FL, "*") > 0 Then
POFilters = POFilters & " UPPER(po.po_bn) LIKE '%" & Replace(UCase(FL), "*", "") & "%' "
Else
POFilters = POFilters & " UPPER(po.po_bn) in ('" & UCase(FL) & "') "
End If
End If
'This is to refresh PO Data for Look Up
Set POData = ThisWorkbook.Sheets(Sheet5.Name)
POData.Cells.Clear
Sql1 = "WITH build_filter_1 AS ( SELECT build_id FROM dcgs.build_schedule WHERE build_id LIKE '%DCA%')," & _
"build_filter_2 AS ( SELECT build_id FROM dcgs.build_schedule WHERE NOT build_id LIKE '%DCA%' AND build_id LIKE '%.001%')," & _
"build_data AS ( SELECT fbn, CASE WHEN cluster ILIKE'%UNK%' THEN LEFT ( fbn, 3 ) ELSE cluster END AS region, site " & _
"FROM dcgs.build_schedule " & _
"WHERE ( fbn LIKE'%ROM%' OR fbn LIKE'%PRX%' OR fbn LIKE'%IGL%' ) " & _
"AND build_id IN ( SELECT * FROM build_filter_1 UNION ALL SELECT * FROM build_filter_2) " & _
"AND NOT build_status = 'CANCELED'), "
Sql2 = Sql1 & vbNewLine & _
"po AS ( SELECT aa.organization, aa.po_number, aa.po_line_number, aa.buyer, aa.requester, " & _
"aa.po_creation_date, aa.po_close_status, TRIM ( aa.fbn ) AS po_fbn, aa.project, aa.currency, " & _
"aa.unit_price, ROUND(aa.quantity,2) AS quantity, ROUND(aa.quantity_received,2) AS quantity_received, " & _
"ROUND(aa.adjamtord,2) AS amount_ordered, ROUND(aa.adjamtbil,2) AS amount_billed, " & _
"aa.vendor, REGEXP_REPLACE( aa.item_description, '[^[:alnum:]]', ' ' ) AS item_description, " & _
"aa.car_lines, aa.category AS po_category, aa.sub_category, aa.exchange_rate, " & _
"CASE WHEN aa.car_Lines = 'Design_and_Engineering' THEN 'Design' " & _
"WHEN aa.car_Lines = 'Electrical' THEN 'Electrical_Equipment' " & _
"WHEN aa.car_Lines = 'Mechanical' THEN 'Mechanical_Equipment' ELSE aa.car_Lines END category1, " & _
"b.qty_subcategory, b.value_subcategory, cr.line_category_renamed, " & _
"CASE WHEN ca.car_classification = 'Boomerang' THEN 'Yes' ELSE 'No' END AS car_exceptions, " & _
"ROW_NUMBER() OVER ( PARTITION BY aa.project, aa.po_number, aa.item_description ) AS dedupe " & _
"FROM awscfpa.dcgs.po_new aa " & _
"LEFT JOIN dcgs.invoice_att b ON b.item_desc = aa.item_description " & _
"LEFT JOIN dcgs.cat_rename cr ON cr.line_category = aa.category " & _
"LEFT JOIN dcgs.car_att ca ON ca.car_num = aa.project " & _
"WHERE aa.car_lines <> 'Network' AND aa.acct_type = 'CapEx' " & _
"AND ( aa.Quantity <> 0 OR aa.Quantity_Received <> 0 OR aa.Amount_Billed <> 0 OR aa.Amount_Ordered <> 0 OR aa.AdjAmtBil <> 0 OR aa.AdjAmtOrd <> 0 ) " & _
"AND TRIM ( aa.fbn ) IN ( SELECT TRIM ( fbn ) FROM build_data ))"
If POFilters = "" Then
Sql3 = Sql2 & vbNewLine & _
"SELECT po.organization, po.po_number, po.po_line_number, po.buyer, po.requester, po.po_creation_date," & _
"po.po_close_status, po.po_fbn, po.project, po.currency, po.unit_price, po.quantity, po.quantity_received," & _
"po.amount_ordered, po.amount_billed, po.vendor, po.item_description, po.car_lines, po.po_category," & _
"po.sub_category, po.exchange_rate, po.category1, po.qty_subcategory, po.value_subcategory, po.line_category_renamed, po.car_exceptions " & _
"FROM po WHERE dedupe = 1"
Else
Sql3 = Sql2 & vbNewLine & _
"SELECT po.organization, po.po_number, po.po_line_number, po.buyer, po.requester, po.po_creation_date," & _
"po.po_close_status, po.po_fbn, po.project, po.currency, po.unit_price, po.quantity, po.quantity_received," & _
"po.amount_ordered, po.amount_billed, po.vendor, po.item_description, po.car_lines, po.po_category," & _
"po.sub_category, po.exchange_rate, po.category1, po.qty_subcategory, po.value_subcategory, po.line_category_renamed, po.car_exceptions " & _
"FROM po WHERE " & POFilters & " AND dedupe = 1"
End If
rs3.ActiveConnection = con
rs3.Open Sql3
Set qt3 = POData.ListObjects.Add(SourceType:=XlListObjectSourceType.xlSrcQuery, _
Source:=rs3, Destination:=POData.Range("A1")).QueryTable
qt3.Refresh
rs3.Close
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Call DeleteConnections
MsgBox ("Report has encountered an error:" & vbNewLine & Err.Number & " - " & Err.Description & vbNewLine & "Please reach out to <email> for a solution.")
Application.ScreenUpdating = True
End Sub
我有另外两个记录集，它们是相同的代码，具有不同的查询，但没有问题。其中一个不同的查询是 64 行 x 18 列，但它有一个交叉连接，并且 运行 也需要大约 10 秒。
我还尝试使用 CopyFromRecordset 更改记录集的输入方式，它做同样的事情。当我 Debug.Print rs3.RecordCount 我得到 -1 时，我怀疑这并不意外，因为这是 Redshift，它可能不知道有多少。
这个导致 excel 没有响应，我不知道为什么或如何解决它。
- 有解决问题的方法吗？
- 是否有更好的方法将此数据从 Redshift 导入 excel？
编辑：
我尝试执行以下操作：
con.CommandTimeout = 60
Set rs3 = con.Execute(POSql3)
If Not rs3.EOF Then
With POData
.Activate
.Range("A1").CopyFromRecordset rs3
End With
End If
我收到以下错误：
-2147217887 - Multiple-step OLE DB operation generated errors. Check each OLE DB status value, if available. No work was done.
不知道该怎么办。
评论太长，但请尝试添加一些时间...
Dim t, n As Long
t = Timer
rs3.ActiveConnection = con
Debug.Print "Connected", Timer-t
rs3.Open Sql3
Debug.Print "Opened recordset", Timer-t
Do While Not rs3.EOF
n = n + 1
If n Mod 20 = 0 Then Debug.Print "Fetched " & n, Timer - t
rs3.MoveNext
Loop
Debug.Print "Completed (" & n & " records )", Timer - t
你看到什么输出？
下面是一个代码模式，您需要采用和适应。在名为 AsyncQuery 的 class 中添加以下代码
Option Explicit
Private WithEvents cnAsynchronousConnection As ADODB.Connection
Public Sub RunAsyncQuery()
Set cnAsynchronousConnection = New ADODB.Connection
cnAsynchronousConnection.connectionString = "<my conn string>" '<---- Insert your connection string
cnAsynchronousConnection.Open
Debug.Print "Preparing to execute asynchronously: " & Now
cnAsynchronousConnection.Execute "<select query>", adAsyncExecute '<----- Insert you own query
Debug.Print "Has begun executing asynchronously: " & Now
End Sub
Private Sub cnAsynchronousConnection_ExecuteComplete(ByVal RecordsAffected As Long, _
ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, _
ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
Debug.Print "The query has completed asynchronously: " & Now
End Sub
然后在一个标准模块中添加如下代码
选项显式
Sub Test()
Dim oAsyncQuery As AsyncQuery
Set oAsyncQuery = New AsyncQuery
oAsyncQuery.RunAsyncQuery
End Sub
这提供了异步查询执行。抱歉，我无法调试您的查询，但至少 Excel 会保持响应。
上创建了这段代码
我发现 MS Excel 在执行您的代码期间没有响应的几个可能原因。
- 子查询过多。尝试使用
JOIN 来减少子查询的数量。
- 当您使用
Open 方法时，记录集以 CursorType=adOpenForwardOnly 模式打开，如果您想向前滚动记录，这很好。我建议使用 adOpenStatic 生成静态报告。您可以使用其他可选参数来改进查询执行。参见：ADODB.Recordset.Open method
qt3.Refresh 命令导致 MS Excel 重新查询数据。所以，这个命令似乎是多余的，因为你指的是新创建的记录集。参见：QueryTable.Refresh method
我不知道为什么 运行 在 10-11 秒内直接导致 Excel 停止响应的查询。即使是只有 193 行 x 26 列的此查询的更多过滤版本也会导致同样的问题。
按顺序启用的引用：
- VB 应用
- MS Excel 16.0 对象库
- OLE 自动化
- MS Office 16.0 对象库
- MS ActiveX 数据对象 6.1 库
- MS Forms 2.0 对象库
- MS ActiveX 数据对象 Recordset 2.8 库（也试过 6.0 以防万一）
我正在尝试为记录集创建一个查询表以将数据转储到：
Option Explicit
Sub Import_Data()
On Error GoTo ErrorHandler
Dim BCS As Worksheet
Dim dv As Worksheet
Dim RegAtt As Worksheet
Dim POData As Worksheet
Dim CARData As Worksheet
Dim UserDefinedFilters As String
Dim POFilters As String
Dim Site_List As String
Dim CL As String
Dim FL As String
Dim scenario_year As Integer
Dim Scenario As String
Dim RegSql As String
Dim POSql1 As String
Dim POSql2 As String
Dim POSql3 As String
Dim BCSSql1 As String
Dim BCSSql2 As String
Dim BCSSql3 As String
Dim BCSSql4 As String
Dim CS As String
Dim CS64 As String
Dim CS32 As String
Dim response As String
Dim con As ADODB.Connection
Dim Rs As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim rs4 As Recordset
Dim qt As Variant
Dim qt2 As Variant
Dim qt3 As Variant
Dim hdrs As Variant
Dim i As Variant
Set con = New ADODB.Connection
Set rs3 = CreateObject("ADODB.RECORDSET")
Call DeleteConnections
'Test for Mac
#If Mac Then
'if Mac then use this driver
CS = "Driver={Amazon Redshift};SERVER={<rs>};UID=<user>;PASSWORD=<pwd>;DATABASE=<db>;PORT=8192"
#ElseIf Win64 Then
CS64 = "Driver={Amazon Redshift (x64)};SERVER={<rs>};UID=<user>;PASSWORD=<pwd>;DATABASE=<db>;PORT=8192"
con.Open CS64
#Else
CS32 = "Driver={Amazon Redshift (x86)};SERVER={<rs>};UID=<user>;PASSWORD=<pwd>;DATABASE=<db>;PORT=8192"
con.Open CS32
#End If
Application.ScreenUpdating = False
'Filter Fields
Site_List = UCase(ThisWorkbook.Sheets(Sheet1.Name).Range("D1").Value)
CL = UCase(ThisWorkbook.Sheets(Sheet1.Name).Range("D2").Value)
FL = UCase(ThisWorkbook.Sheets(Sheet1.Name).Range("D3").Value)
scenario_year = ThisWorkbook.Sheets(Sheet1.Name).Range("D4").Value
Scenario = "'" & ThisWorkbook.Sheets(Sheet1.Name).Range("D5").Value & "'"
'POData Filters
If CL <> "" And FL <> "" Then
CL = Replace(CL, ", ", ",")
FL = Replace(FL, ", ", ",")
POFilters = POFilters & "UPPER(LEFT(po.po_fbn,3)) in ('" & Replace(CL, ",", "','") & "') " & _
vbNewLine & " AND UPPER(po.po_bn) in ('" & Replace(FL, ",", "','") & "') "
ElseIf CL <> "" And FL = "" Then
CL = Replace(CL, ", ", ",")
POFilters = POFilters & "UPPER(LEFT(po.po_bn,3)) in ('" & Replace(CL, ",", "','") & "') "
ElseIf CL = "" And FL <> "" Then
If InStr(1, FBNList, ",") > 0 Then
FL = Replace(FL, ", ", ",")
POFilters = POFilters & " UPPER(po.po_bn) in ('" & Replace(UCase(FL), ",", "','") & "') "
ElseIf InStr(1, FL, "*") > 0 Then
POFilters = POFilters & " UPPER(po.po_bn) LIKE '%" & Replace(UCase(FL), "*", "") & "%' "
Else
POFilters = POFilters & " UPPER(po.po_bn) in ('" & UCase(FL) & "') "
End If
End If
'This is to refresh PO Data for Look Up
Set POData = ThisWorkbook.Sheets(Sheet5.Name)
POData.Cells.Clear
Sql1 = "WITH build_filter_1 AS ( SELECT build_id FROM dcgs.build_schedule WHERE build_id LIKE '%DCA%')," & _
"build_filter_2 AS ( SELECT build_id FROM dcgs.build_schedule WHERE NOT build_id LIKE '%DCA%' AND build_id LIKE '%.001%')," & _
"build_data AS ( SELECT fbn, CASE WHEN cluster ILIKE'%UNK%' THEN LEFT ( fbn, 3 ) ELSE cluster END AS region, site " & _
"FROM dcgs.build_schedule " & _
"WHERE ( fbn LIKE'%ROM%' OR fbn LIKE'%PRX%' OR fbn LIKE'%IGL%' ) " & _
"AND build_id IN ( SELECT * FROM build_filter_1 UNION ALL SELECT * FROM build_filter_2) " & _
"AND NOT build_status = 'CANCELED'), "
Sql2 = Sql1 & vbNewLine & _
"po AS ( SELECT aa.organization, aa.po_number, aa.po_line_number, aa.buyer, aa.requester, " & _
"aa.po_creation_date, aa.po_close_status, TRIM ( aa.fbn ) AS po_fbn, aa.project, aa.currency, " & _
"aa.unit_price, ROUND(aa.quantity,2) AS quantity, ROUND(aa.quantity_received,2) AS quantity_received, " & _
"ROUND(aa.adjamtord,2) AS amount_ordered, ROUND(aa.adjamtbil,2) AS amount_billed, " & _
"aa.vendor, REGEXP_REPLACE( aa.item_description, '[^[:alnum:]]', ' ' ) AS item_description, " & _
"aa.car_lines, aa.category AS po_category, aa.sub_category, aa.exchange_rate, " & _
"CASE WHEN aa.car_Lines = 'Design_and_Engineering' THEN 'Design' " & _
"WHEN aa.car_Lines = 'Electrical' THEN 'Electrical_Equipment' " & _
"WHEN aa.car_Lines = 'Mechanical' THEN 'Mechanical_Equipment' ELSE aa.car_Lines END category1, " & _
"b.qty_subcategory, b.value_subcategory, cr.line_category_renamed, " & _
"CASE WHEN ca.car_classification = 'Boomerang' THEN 'Yes' ELSE 'No' END AS car_exceptions, " & _
"ROW_NUMBER() OVER ( PARTITION BY aa.project, aa.po_number, aa.item_description ) AS dedupe " & _
"FROM awscfpa.dcgs.po_new aa " & _
"LEFT JOIN dcgs.invoice_att b ON b.item_desc = aa.item_description " & _
"LEFT JOIN dcgs.cat_rename cr ON cr.line_category = aa.category " & _
"LEFT JOIN dcgs.car_att ca ON ca.car_num = aa.project " & _
"WHERE aa.car_lines <> 'Network' AND aa.acct_type = 'CapEx' " & _
"AND ( aa.Quantity <> 0 OR aa.Quantity_Received <> 0 OR aa.Amount_Billed <> 0 OR aa.Amount_Ordered <> 0 OR aa.AdjAmtBil <> 0 OR aa.AdjAmtOrd <> 0 ) " & _
"AND TRIM ( aa.fbn ) IN ( SELECT TRIM ( fbn ) FROM build_data ))"
If POFilters = "" Then
Sql3 = Sql2 & vbNewLine & _
"SELECT po.organization, po.po_number, po.po_line_number, po.buyer, po.requester, po.po_creation_date," & _
"po.po_close_status, po.po_fbn, po.project, po.currency, po.unit_price, po.quantity, po.quantity_received," & _
"po.amount_ordered, po.amount_billed, po.vendor, po.item_description, po.car_lines, po.po_category," & _
"po.sub_category, po.exchange_rate, po.category1, po.qty_subcategory, po.value_subcategory, po.line_category_renamed, po.car_exceptions " & _
"FROM po WHERE dedupe = 1"
Else
Sql3 = Sql2 & vbNewLine & _
"SELECT po.organization, po.po_number, po.po_line_number, po.buyer, po.requester, po.po_creation_date," & _
"po.po_close_status, po.po_fbn, po.project, po.currency, po.unit_price, po.quantity, po.quantity_received," & _
"po.amount_ordered, po.amount_billed, po.vendor, po.item_description, po.car_lines, po.po_category," & _
"po.sub_category, po.exchange_rate, po.category1, po.qty_subcategory, po.value_subcategory, po.line_category_renamed, po.car_exceptions " & _
"FROM po WHERE " & POFilters & " AND dedupe = 1"
End If
rs3.ActiveConnection = con
rs3.Open Sql3
Set qt3 = POData.ListObjects.Add(SourceType:=XlListObjectSourceType.xlSrcQuery, _
Source:=rs3, Destination:=POData.Range("A1")).QueryTable
qt3.Refresh
rs3.Close
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
Call DeleteConnections
MsgBox ("Report has encountered an error:" & vbNewLine & Err.Number & " - " & Err.Description & vbNewLine & "Please reach out to <email> for a solution.")
Application.ScreenUpdating = True
End Sub
我有另外两个记录集，它们是相同的代码，具有不同的查询，但没有问题。其中一个不同的查询是 64 行 x 18 列，但它有一个交叉连接，并且 运行 也需要大约 10 秒。
我还尝试使用 CopyFromRecordset 更改记录集的输入方式，它做同样的事情。当我 Debug.Print rs3.RecordCount 我得到 -1 时，我怀疑这并不意外，因为这是 Redshift，它可能不知道有多少。
这个导致 excel 没有响应，我不知道为什么或如何解决它。
- 有解决问题的方法吗？
- 是否有更好的方法将此数据从 Redshift 导入 excel？
编辑：
我尝试执行以下操作：
con.CommandTimeout = 60
Set rs3 = con.Execute(POSql3)
If Not rs3.EOF Then
With POData
.Activate
.Range("A1").CopyFromRecordset rs3
End With
End If
我收到以下错误：
-2147217887 - Multiple-step OLE DB operation generated errors. Check each OLE DB status value, if available. No work was done.
不知道该怎么办。
评论太长，但请尝试添加一些时间...
Dim t, n As Long
t = Timer
rs3.ActiveConnection = con
Debug.Print "Connected", Timer-t
rs3.Open Sql3
Debug.Print "Opened recordset", Timer-t
Do While Not rs3.EOF
n = n + 1
If n Mod 20 = 0 Then Debug.Print "Fetched " & n, Timer - t
rs3.MoveNext
Loop
Debug.Print "Completed (" & n & " records )", Timer - t
你看到什么输出？
下面是一个代码模式，您需要采用和适应。在名为 AsyncQuery 的 class 中添加以下代码
Option Explicit
Private WithEvents cnAsynchronousConnection As ADODB.Connection
Public Sub RunAsyncQuery()
Set cnAsynchronousConnection = New ADODB.Connection
cnAsynchronousConnection.connectionString = "<my conn string>" '<---- Insert your connection string
cnAsynchronousConnection.Open
Debug.Print "Preparing to execute asynchronously: " & Now
cnAsynchronousConnection.Execute "<select query>", adAsyncExecute '<----- Insert you own query
Debug.Print "Has begun executing asynchronously: " & Now
End Sub
Private Sub cnAsynchronousConnection_ExecuteComplete(ByVal RecordsAffected As Long, _
ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, _
ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
Debug.Print "The query has completed asynchronously: " & Now
End Sub
然后在一个标准模块中添加如下代码 选项显式
Sub Test()
Dim oAsyncQuery As AsyncQuery
Set oAsyncQuery = New AsyncQuery
oAsyncQuery.RunAsyncQuery
End Sub
这提供了异步查询执行。抱歉，我无法调试您的查询，但至少 Excel 会保持响应。
上创建了这段代码我发现 MS Excel 在执行您的代码期间没有响应的几个可能原因。
- 子查询过多。尝试使用
JOIN来减少子查询的数量。 - 当您使用
Open方法时，记录集以CursorType=adOpenForwardOnly模式打开，如果您想向前滚动记录，这很好。我建议使用adOpenStatic生成静态报告。您可以使用其他可选参数来改进查询执行。参见：ADODB.Recordset.Open method qt3.Refresh命令导致 MS Excel 重新查询数据。所以，这个命令似乎是多余的，因为你指的是新创建的记录集。参见：QueryTable.Refresh method