Элемент управления 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

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

While...Wend - это более медленный механизм зацикливания;используйте Для ... Следующего.Для...Следующий быстрее - даже если вам придется запустить другую команду, чтобы получить 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 ...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 2

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

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

Answer 3

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

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