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

Question

我从 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

接下来，我想在 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

考虑按照 cmets 中 @TimWilliams 的建议在源头调整 SQL 查询，以避免内存开销和使用操作数据对象。

Crosstab 查询在其结构中使用聚合 groupby，您可以轻松添加标量值，包括空值、数字或字符串值（所有行都相同）：

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 storedquery.*, NULL As EmptyColumn, 1 As AllOnesColumn, 
       'SQL in Excel' As AllStringColumn
FROM storedquery