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），所以你正在做的迭代将耗费时间，将结果转储到工作表，操纵，并且选择它们应该非常快。

我在Excel中使用ADODB记录集很多，所以我有一个模块，我只是导入到任何表格，我在那里。我将要连接到数据库。在我使用的子程序中，我只是向它发送SQL，它应该删除数据的范围和标志，如果它也应该删除标题，以及函数是否应该处理连接。最后一个标志用于我想要打开连接，发出多个SQL语句，然后关闭它。否则只会打开，运行SQL并关闭。

Sub getData(strSQL As String, rngDrop As Range, Optional includeHeaders As Boolean = False, Optional handleConnection As Boolean = True)

    Dim rs As New ADODB.Recordset

    'Little error handling
    On Error GoTo errHandler

    'Open the database (seperate function for creating the connection object)
    If handleConnection Then openConnection

    'set up the recordset
    rs.ActiveConnection = adoConn
    rs.LockType = adLockOptimistic
    rs.CursorLocation = adOpenKeyset
    rs.Open strSQL

    'check for data
    If rs.EOF And rs.BOF Then
        Debug.Print "No data returned. Boo."
        Debug.Print "   Offending SQL:"
        Debug.Print "---------------------------"
        Debug.Print strSQL
        Debug.Print "---------------------------"
    End If

    'clear the range
    rngDrop.ClearContents

    'If the headers are requested, then dump those and offset(1) to dump the data
    If includeHeaders Then
        Dim header As field
        Dim intCol As Integer: intCol = 0

        For Each header In rs.Fields
            rngDrop.Cells(1, 1).Offset(0, intCol).value = header.Name
            intCol = intCol + 1
       Next header
       rngDrop.Cells(1, 1).Offset(1, 0).CopyFromRecordset rs
    Else
        'otherwise just dump the recordset
        rngDrop.CopyFromRecordset rs
    End If

    'clean up
    rs.Close
    If handleConnection Then adoConn.Close
    Exit Sub
errHandler:
    Debug.Print Err.description, vbCritical, "Error " & Err.Number
End Sub

我使用dynamic named ranges作为我传入此函数的范围，以便我可以快速转储然后引用工作表中的数据。这样，我们丢弃数据的范围随着丢弃的数据而增长/缩小。因此，获取一些数据，使用标题，粗体标题，然后将其复制并转置到其他位置，最后将其粘贴到数组中，如下所示：

 Sub test()
     getData("Select f1, f2 FROM table;", Range("MyNamedRange"), True)
     Range("MyNamedRange").Rows(1).Font.Bold = True
     Range("MyNamedRange").Copy 
     Sheet2.Range("A1").pasteSpecial Transpose:=True
     Arr = Sheet2.Range("A1").Resize(Range("myNAmedRange).columns.count, Range("MyNamedRange").Rows.Count)
 End Sub

这可能会被清理掉有点，但它应该工作，它应该很快。

SQL查询到VBA阵列

1 个答案: