Excel VBA：从ADODB结果集中的数组中插入一列

我从VBA中查询了MS-Access数据库，并将结果集返回给一个数组，如下所示：

Sub ChartData() Dim cn As Object Dim rs As Object Dim strSql As String Dim strConnection As String Set cn = CreateObject("ADODB.Connection") ' Hard code database location and name strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\server1\myDB.mdb" ' Construct SQL query strSql = "TRANSFORM Count(Names) AS CountOfNames SELECT Ticker FROM Pricing GROUP BY Ticker PIVOT Source; " ' execute the query, and return the results to the rs object cn.Open strConnection Set rs = cn.Execute(strSql) ' Copy the result set to an array Dim myArr() As Variant myArr = rs.GetRows ' Close the connection rs.Close Set rs = Nothing cn.Close Set cn = Nothing ... End Sub 

接下来，我想插入一个列到具有dynamic维度的myArr。 我试图使用ReDim Preserve来达到这个目的，但是得知ReDim Preserve只允许改变第一个维度。 例如，下面的代码导致运行时错误，下标超出范围 ：

 Sub ChartData() ... Dim newRowCount As Integer Dim newColCount As Integer newRowCount = UBound(myArr, 2) + 1 newColCount = UBound(myArr, 1) + 2 ReDim Preserve myArr(newColCount, newRowCount) ' Run-time error here End Sub 

有没有一个优雅的方法来解决这个ReDim Preserve限制插入一列而不擦除数据？

谢谢！

Answer 1

考虑在注释中根据@TimWilliams的build议在源代码中调整SQL查询，以避免内存开销和使用操作数据对象。

交叉表查询在其结构中使用一个聚合组合，您可以轻松地添加标量值，包括空值，数值或string值（ 在所有行中都是相同的 ）：

 TRANSFORM Count(Names) AS CountOfNames SELECT Ticker, NULL As EmptyColumn, 1 As AllOnesColumn, 'SQL in Excel' As AllStringColumn FROM Pricing GROUP BY Ticker PIVOT Source; 

或者，将交叉表查询保存为Access数据库中存储的查询对象，并在引用存储的查询的Excel ADO连接中运行典型的select语句。 再次，您可以根据需要添加标量列：

 SELECT storedquery.*, NULL As EmptyColumn, 1 As AllOnesColumn, 'SQL in Excel' As AllStringColumn FROM storedquery