Улучшить скорость заполнения VBA ListBox - PullRequest
Новая
       13

Улучшить скорость заполнения VBA ListBox

0 голосов
/ 02 октября 2018

Ищите способ повысить производительность заполнения списка VBA в пользовательской форме в Excel.Я создал функцию для подключения к базе данных SQL, запроса необходимых мне данных и создания набора записей, который я перебираю для заполнения ListBox.Сам запрос и получение данных, кажется, быстро, медлительность, кажется, является методом заполнения элемента управления ListBox.Я попробовал 2 подхода, в настоящее время использующих массив, так как он был немного быстрее.

Это занимает 13-14 секунд, чтобы заполнить только 50 строк в ListBox.Слишком длинный. 

Function GetComments(intRFQ_ID As Integer) As Integer

Dim dbCmnd As ADODB.Command
Dim dbConn As ADODB.Connection
Dim rstSQLquery As ADODB.Recordset
Set dbCmnd = New ADODB.Command
Set dbConn = New ADODB.Connection

AA_SQL_Vars
dbConn.ConnectionString = "driver={SQL Server};server=" & strDBserver & ";uid=" & strDBuser & ";pwd=" & strDBpass & ";database=" & strDBname
dbConn.Open

frmCommentsView.ListBox1.Clear
ListCnt = 0
RmkCnt = 0
strSQLSelect = ""
strSQLSelect = strSQLSelect & "SELECT [Created],[Comments],[Created_By] "
strSQLSelect = strSQLSelect & "FROM [dbPricing].[dbo].[tblRFQ_Comments] "
strSQLSelect = strSQLSelect & "Where [RFQ_ID] = '" & intRFQ_ID & "'"
strSQLSelect = strSQLSelect & "Order by [Created]"
Set rstSQLquery = New ADODB.Recordset
rstSQLquery.Open strSQLSelect, dbConn, adOpenStatic, adLockReadOnly, adCmdText

'This is slightly faster
lngRecords = rstSQLquery.RecordCount
If lngRecords > 0 Then
    ReDim strRecords(lngRecords - 1, 3)
    While Not rstSQLquery.EOF
        RmkCnt = RmkCnt + 1
            strRecords(ListCnt, 0) = Format(rstSQLquery.Fields("Created").Value, "YYMMDD HHMM")
            strRecords(ListCnt, 1) = Trim(rstSQLquery.Fields("Comments").Value)
            strRecords(ListCnt, 2) = Trim(rstSQLquery.Fields("Created_By").Value)
        ListCnt = ListCnt + 1
        rstSQLquery.MoveNext
    Wend
    frmCommentsView.ListBox1.List() = strRecords
Else
    frmCommentsView.ListBox1.Clear
End If

'' WHY IS THIS SO SLOW????
'While (Not (rstSQLquery.EOF))
'    RmkCnt = RmkCnt + 1
'    frmCommentsView.ListBox1.AddItem
'    If IsNull(Trim(rstSQLquery.Fields("Created").Value)) Then
'    Else
'        frmCommentsView.ListBox1.List(ListCnt, 0) = Format(Trim(rstSQLquery.Fields("Created").Value), "YYMMDD HHMM")
'    End If
'    If IsNull(Trim(rstSQLquery.Fields("Comments").Value)) Then
'    Else
'        frmCommentsView.ListBox1.List(ListCnt, 1) = Trim(rstSQLquery.Fields("Comments").Value)
'    End If
'    If IsNull(Trim(rstSQLquery.Fields("Created_By").Value)) Then
'    Else
'        frmCommentsView.ListBox1.List(ListCnt, 2) = Trim(rstSQLquery.Fields("Created_By").Value)
'    End If
'    rstSQLquery.MoveNext
'    ListCnt = ListCnt + 1
'Wend

rstSQLquery.Close

GetComments = RmkCnt

dbConn.Close
Set rstSQLquery = Nothing
Set dbConn = Nothing

End Function
...