对 VBA 数组的 SQL 查询

Question

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

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

这是ok，但这会将所有信息垂直而不是水平存储。有没有办法翻转它？那会是通过使用 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

我认为将结果转储到工作表会更快：

Sheet1.Range("A1").CopyFromRecordset rst

然后将该转储的结果（来自范围）存储到一个数组中。如果它不是您喜欢的垂直或水平，快速复制/粘贴特殊转置将在将其放回数组之前快速处理它。

我只是建议，因为您的记录集似乎相当大（2x10000），所以在您进行迭代时将非常耗时，将结果转储到工作表、操作并重新拾取它们应该很快。

---

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

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