如何使用未知大小的记录集填充数组?

时间:2015-12-29 19:39:12

标签: vba

这就是我现在所拥有的。我觉得这不是最有效的方法,但我不知道如何在不使用该函数检查第一个元素的数组是否为空的情况下如何做。

marginrec.Open querystr, margincon

Do Until marginrec.EOF

    If Not IsNull(marginrec.Fields("term")) Then
        If Isarrempty(termarray) Then
            ReDim termarray(0)
            termarray(0) = marginrec.Fields("term")
        Else
            Ut = UBound(termarray)

            ReDim Preserve termarray(Ut + 1)

            termarray(Ut + 1) = marginrec.Fields("term")
        End If
    End If

    marginrec.movenext
Loop

-

Function Isarrempty(ByVal moagg As Variant) As Boolean

Dim b As Integer

On Error Resume Next

b = LBound(moagg)

If Err.Number <> 0 Then
    Isarrempty = True
Else
    Isarrempty = False
End If

On Error GoTo 0

End Function

编辑:我想我也可以计算记录集的记录,然后使用一个redim语句

3 个答案:

答案 0 :(得分:3)

如果RecordSet将返回一个Count,请将其与ReDim一起使用,作为上次编辑状态。

有时Count总是返回零,我认为这取决于使用RecordSet创建的游标类型。

解决方法是创建第二个SQL语句,该语句具有相同的Where子句,返回计数。

select count(*) ...

首先运行它以设置ReDim ...

答案 1 :(得分:0)

此问题属于Code Review,因为它正在运行。但是,一种方法是:

If Not marginRec.EOF Then
        ReDim termarray(0)
        termarray(0) = marginrec.Fields("term")
        marginRec.MoveNext
End If
Do Until marginRec.EOF
    Ut = UBound(termarray)
    ReDim Preserve termarray(Ut+1)
    termarray(Ut + 1) = marginrec.Fields("term")
    marginRec.MoveNext
Loop

虽然正如您在编辑中提到的那样,最好的方法是将其尺寸标注一次,因为每次花费大量时间没有实际目的时,对数组进行重新定标。

答案 2 :(得分:0)

以下是如何使用记录集字段的值填充数组的示例:

Option Explicit

Sub RecordsetToArray()

    Dim strConnection As String
    Dim strQuery As String
    Dim objConnection As Object
    Dim objRecordSet As Object
    Dim arrField
    Dim lngUBound As Long
    Dim arrData() As String
    Dim i As Long

    ' connect to this workbook
    strConnection = _
        "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "User ID=Admin;" & _
        "Data Source='" & ThisWorkbook.FullName & "';" & _
        "Mode=Read;" & _
        "Extended Properties=""Excel 12.0 Macro;"";"
    ' select all data from sheet1
    strQuery = _
        "SELECT * FROM [Sheet1$];"
    ' connect and query
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Open strConnection
    Set objRecordSet = objConnection.Execute(strQuery)
    ' convert selected field of the recordset to 2-dimensional array
    arrField = objRecordSet.GetRows(, , "ContactName")
    objConnection.Close
    ' get max index of the second dimension
    lngUBound = UBound(arrField, 2)
    ' set number of elements of target 1-dimensional array
    ReDim arrData(lngUBound)
    ' copy the values from 2d array to target array
    For i = 0 To lngUBound
        arrData(i) = arrField(0, i)
    Next

End Sub

Sheet1内容是该测试查询的主要内容,如下所示:

Source1.xlsx

生成的arrData数组包含'ContactName'字段的值:

arrData content

它适用于Excel 2010 64位。正如您所看到的,只需要使ReDim一次,并且可以通过使用GetRows method检索的二维数组的最大索引来计算元素数量。