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 只允许更改第一个维度。例如，下面的代码会导致运行-time 错误，下标超出范围:

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 在评论中的建议在源头调整 SQL 查询，从而避免内存开销和使用操作数据对象。

交叉表查询在其结构中使用聚合 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 数据库中的存储查询对象，并将运行典型的 select 语句保存在 Excel ADO 连接中引用存储的查询。同样，您可以根据需要添加标量列：

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

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

Excel VBA: Insert a column in an Array from an ADODB Result Set

excel

ms-access

vba

adodb