SQL 查询 VBA 数组

Question

如标题所示，我正在研究将查询内容存储到数组中的不同方法。我一直在尝试不同的方法来做这件事，但似乎大多数这些方法的输出都是正确的。这当然是因为我不了解应该如何适当地完成这项工作，所以经过一段时间的试验后，我决定问问最好的方法是什么？到目前为止，我将与您分享我的一些方法，您可以看到我的调查结果。

Dim MyArray() As Variant
MyArray = rst.GetRows(rst.RecordCount)

这还行但这存储了所有信息的垂直方向而不是水平方向。有没有办法翻转它？那会是通过使用 ReDim 吗？或者这是因为行存储在数组维度中，因此它们自然垂直？

        Index = 0
        Do While Not rst.EOF
                ReDim Preserve MyArray(1, Index)
                MyArray(0, Index) = CStr(rst.Fields(0).Value)

                'Safety check to make sure the value isn't null (was having problems before)
                If rst.Fields(1).Value <> vbNullString Then
                    MyArray(1, Index) = CStr(rst.Fields(1).Value)
                End If
            Index = Index + 1
            rst.MoveNext
        Loop

        sheet.Range("a1:ba10000").Value = MyArray

这又是垂直存储，但没有正确输出记录，实际上每条记录只拉出前两列信息，其余输出为#N/A#。我认为我更接近于原来的方法，但我决定进行实验可能会让我有所收获。

你们有什么建议或者能给我指明正确的方向吗？

Answer 1

我认为使用以下方法将结果转储到 sheet 会更快：

Sheet1.Range("A1").CopyFromRecordset rst

然后将该转储的结果（来自该范围）存储到一个数组中。如果它不是您喜欢的垂直或水平，快速 copy/paste-special 转置将非常快速地处理它，然后再将它放回数组中。

我只是建议，因为您的记录集似乎相当大 (2x10000)，所以像您一样进行迭代会很耗时，将结果转储到工作中sheet，操纵和捡起它们应该非常非常快。

更新（多年后）。看起来可以转储到数组中。类似于：

Dim arr
rst.MoveFirst
arr = rst.GetRows

这将允许在将数据发送到工作簿之前对记录集（在数组中）进行编程操作。

Answer 2

这应该可以回答您的问题，尽管晚了 5 年。 记录集到数组到工作表

ReDim Preserve只能用于调整上一个维度的上限。您还没有 1 个，所以没有 ReDim Preserve。

'Goes on Top
Option Explicit
Option Compare Text
Option Base 1

Public Sub Recordset_to_Array_to_Worksheet()

Dim MyArray() As Variant 'unbound Array with no definite dimensions'
Dim db as DAO.Database
Dim rst as DAO.Recordset
Dim strSQL as String, Fieldname as String
Dim i as Integer, j as Integer, colcnt as Integer, rowcnt as Integer
Dim wb as Workbook
Dim ws as Worksheet
Dim Dest as Range

'------------------------RECORDSET------------------------'
Set db = Opendatabase("URL link") 'or Set db = Currentdb()
strSQL = "SQL Statement Here"

Set rst = db.OpenRecordset(strsQL, dbOpenDynaset)

If rst.recordcount <> 0 then '///Do NOT Use "Do While Not rst.EOF" Can cause Problems///'
    colcnt = rst.Fields.Count-1
    rowcnt = rst.recordcount
 Else
    Exit Sub
End IF

'-----------------------------WRITE RECORDSET TO MYARRAY----------------------------'
ReDim MyArray (rowcnt, colcnt) 'Redimension MyArray parameters to fit the SQL returned'
rst.MoveFirst

'Populating Array with Headers from Recordset'
For j = 0 To colcnt
     MyArray(0,j) = rst.Fields(j).name
Next

'Populating Array with Record Data
For i = 1 to rowcnt
    For j = 0 to colcnt
        MyArray(i,j) = rst(j)
    Next J
    rst.movenext
Next i

'---------------------------------WORKSHEET OUTPUT---------------------------------'
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Insert Worksheet Name")
Set Dest = ws.Range("A1") 'Destination Cell
Dest.Resize(UBound(MyArray, 1) + 1, UBound(MyArray, 2) + 1).value = 
Application.Transpose(MyArray) 'Resize (secret sauce)

End Sub

SQL 查询 VBA 数组

SQL Query to VBA Array

sql

arrays

excel

vba

recordset