Элемент управления ListView загружается очень медленно

Question

Какой самый быстрый способ заполнить ListView из запроса, когда у него более 15000 списков с 9 подпунктами. загрузка занимает у меня около 6 минут.

Вот что я написал для заполнения элемента управления ListView.

Set rs = db.OpenRecordset(strSQL, dbOpenForwardOnly, dbReadOnly)

With Me.listViewData
    .View = lvwReport
    .GridLines = True
    .FullRowSelect = True
    .ListItems.Clear
    .ColumnHeaders.Clear
End With
'Set up column headers
With Me.listViewData.ColumnHeaders
    .Add , , "Client", 1440, lvwColumnLeft
    .Add , , "Contact", 2160, lvwColumnLeft
    .Add , , "Quote #", 720, lvwColumnCenter
    .Add , , "Date", 1140, lvwColumnLeft
    .Add , , "GrandTotal", 1440, lvwColumnRight
    .Add , , "Weighted Value", 1440, lvwColumnRight
    .Add , , "Chance %", 500, lvwColumnRight
    .Add , , "Sales Cycle", 1140, lvwColumnRight
    .Add , , "Won Orders", 1000, lvwColumnRight
    .Add , , "SalesRep", 1000, lvwColumnRight
End With

While Not rs.EOF
    Set lstItem = Me.listViewData.ListItems.Add()
    lstItem.Text = Nz(rs!Name, "")
    lstItem.SubItems(1) = Nz(rs!Company, "")
    lstItem.SubItems(2) = Nz(rs!QuoteNumber, "")
    lstItem.SubItems(3) = Nz(rs!OrderDate, "")
    lstItem.SubItems(4) = Nz(Format(rs!GrandTotal, "Currency"), "0.00")
    lstItem.SubItems(5) = Nz(Format(rs!GrandTotal * rs!Customfield1 / 100, "Currency"), "")
    lstItem.SubItems(6) = Nz(rs!Customfield1, "")
    lstItem.SubItems(7) = Nz(rs!Date1, "none")
    lstItem.SubItems(8) = Nz(rs!Detail, "")
    lstItem.SubItems(9) = Nz(rs!CustomT1, Nz(rs!UserID, ""))

    For I = 1 To Me.listViewData.ColumnHeaders.Count - 1
        Set sb = lstItem.ListSubItems(I)
        If rs!Customfield1 = 100 Or Not IsNull(rs!List) Then
            sb.ForeColor = vbBlue
            lstItem.ForeColor = vbBlue
        ElseIf rs!Cancelled = -1 Then
            sb.ForeColor = vbRed
            lstItem.ForeColor = vbRed
        Else
            sb.ForeColor = vbBlack
            lstItem.ForeColor = vbBlack
        End If
        DoEvents
    Next
    rs.MoveNext
Wend

Answer 1

Первое, что вы должны сделать, это избавиться от «doevents». Это настоящий убийца производительности.

Вам нужно динамически загружать просмотр списка? Почему бы не связать его напрямую с источником данных?

Answer 2

Я могу вспомнить пару вещей:

Пока ... Венд - более медленный петлевой механизм; использовать для ... Далее. For ... Next быстрее - даже если вам нужно запустить другую команду, чтобы получить RecordCount. Вот что я использую:

With rs
  If .RecordCount > 0 Then
    '-- MoveLast...MoveFirst will update the .RecordCount; depending on the type of DAO Recordset, RecordCount might only return "1" when there are more than that.
    .MoveLast
    .MoveFirst

    For lngCounter = 1 To .RecordCount
      '-- Code to add ListItems here

      .MoveNext
    Next lngCounter
  End If
  .Close
End With

Использовать с ... Окончание с для добавления подэлементов:

With Me.listViewData.ListItems.Add
  .Text = Nz(rs!Name, "")
  .SubItems(1) = Nz(rs!Company, "")
  .SubItems(2) = Nz(rs!QuoteNumber, "")
  .SubItems(3) = Nz(rs!OrderDate, "")
  .SubItems(4) = Nz(Format(rs!GrandTotal, "Currency"), "0.00")
  .SubItems(5) = Nz(Format(rs!GrandTotal * rs!Customfield1 / 100, "Currency"), "")
  .SubItems(6) = Nz(rs!Customfield1, "")
  .SubItems(7) = Nz(rs!Date1, "none")
  .SubItems(8) = Nz(rs!Detail, "")
  .SubItems(9) = Nz(rs!CustomT1, Nz(rs!UserID, ""))
End With

Заверните код популяции в:

DoCmd.Echo False

'-- Populate code

DoCmd.Echo True

Надеюсь, это поможет!

Answer 3

Проверьте методы элемента управления Listview на что-то вроде beginupdate / endupdate или установите для параметра false значение false (если это возможно). Это означает, что пользовательский интерфейс не будет пытаться обновить экран после добавления каждого элемента, что значительно ускоряет добавление.

Элемент управления Listview предназначен для работы с большим количеством элементов, поэтому это можно сделать, немного покопавшись.