Excel VBA System Collection Array List

Question

Я пытаюсь найти быстрое решение для добавления данных в Combobox.

У меня есть пользовательская форма, которая используется на двух листах, она создает список адресов, в зависимости от активного листа, список адресов создается с одного из двух листов.

Ниже приведен код, который у меня есть в настоящее время, если имя активного листа = SCHECK.name, то я использую System.Collection.ArrayList, чтобы создать список уникальных отсортированных значений из листа WIR, который добавляется в Combobox.

Если активным листом является S20FA, тогда создайте список из CAL. Я хотел бы использовать System Collection, чтобы создать это, поскольку это намного быстрее, чем решение, которое у меня в настоящее время создает массив, затем перебирает массив и добавляет в Combobox.

Проблема с этим, я не уверен, как выполнить проверки, которые мне нужны, с System.Collection.ArrayList, прежде чем адрес будет добавлен в массив.

Наряду с этим можно ли использовать System.Collection.ArrayList для создания многомерного массива fo с многоколоновыми Combobox?

Dim wb As Workbook: Set wb = ThisWorkbook 
Dim myArrayList As Object 
Dim i, lastRow As Long 
Dim address() As String 
Dim number_address As Integer 
Dim cell As Range 
Dim addressList, addressItem 

Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 

Call wb.defineCols 
Call wb.defineSheets 

If ActiveSheet.Name = wb.SCHECK.Name Then 
    If wb.WIR.FilterMode = True Then wb.WIR.AutoFilter.ShowAllData 
    lastRow = wb.WIR.cells(Rows.count, wb.COL_Address_code).End(xlUp).Row 

    Set myArrayList = CreateObject("System.Collections.ArrayList") 
    addressList = wb.WIR.Range(wb.WIR.cells(3, wb.COL_Address_code), wb.WIR.cells(lastRow, wb.COL_Address_code)) 

    With myArrayList 
     For Each addressItem In addressList 
      If Not .Contains(addressItem) Then .add addressItem 
     Next 
     .Sort 
     If .count Then Me.address_combo.List = Application.Transpose(myArrayList.toarray()) 
    End With 
    myArrayList.Clear 
    Set myArrayList = Nothing 
ElseIf ActiveSheet.Name = wb.S20FA.Name Then 
    If wb.CAL.FilterMode = True Then wb.CAL.AutoFilter.ShowAllData 
    lastRow = wb.CAL.cells(Rows.count, "A").End(xlUp).Row 
    Set cellRange = wb.CAL.Range("A8:A" & lastRow) 
    DoEvents 
    number_address = 0 
    For Each cell In cellRange 
     number_address = number_address + 1 
     ReDim Preserve address(number_address - 1) 
      If IsError(Application.match(cell, address, False)) Then 

       '''' Test cells 

       If wb.CAL.Range("G" & cell.Row) <> "" Then 
        If IsError(wb.CAL.Range("K" & cell.Row).value) = False Then 
         If wb.CAL.Range("K" & cell.Row).value <> "" And wb.CAL.Range("K" & cell.Row).value <> 0 Then 
          If (wb.CAL.Range("Q" & cell.Row).value <> "" And wb.CAL.Range("Q" & cell.Row).value <> 0) Or _ 
           (wb.CAL.Range("W" & cell.Row).value <> "" And wb.CAL.Range("W" & cell.Row).value <> 0) Then 
           address(number_address - 1) = wb.CAL.Range("A" & cell.Row).value 
          Else 
           number_address = number_address - 1 
          End If 
         Else 
          number_address = number_address - 1 
         End If 
        End If 
       Else 
        number_address = number_address - 1 
       End If 
      Else 
       number_address = number_address - 1 
      End If 
    Next cell 

    DoEvents 
    For i = 0 To UBound(address) 
     If address(i) <> "" Then 
      address_combo.AddItem address(i) 
     End If 
    Next i 
End If 
Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

Answer 1

Поскольку вы хотите избежать дубликатов, лучше использовать структуру данных, предназначенную для обработки дубликатов. Scripting.Dictionary - отличный инструмент для таких приложений; он отказывает в дублировании ключей, поэтому у него будет чистый и уникальный список в массиве .keys.

Ниже приведена переработка кода с использованием структуры данных словаря. Попробуйте посмотреть, улучшает ли скорость. Обратите внимание, что список не сортируется, но если скорость улучшена, но нам все еще нужна сортировка, мы можем добавить процедуру сортировки позже.

Dim wb As Workbook: Set wb = ThisWorkbook 
Dim dict As Object ' <-- changed the name to correspond to the dictionary 
Dim i, lastRow As Long 
Dim address() As String 
Dim number_address As Integer 
Dim cell As Range 
Dim addressList, addressItem 

Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 

Call wb.defineCols 
Call wb.defineSheets 

If ActiveSheet.Name = wb.SCHECK.Name Then 
    If wb.WIR.FilterMode Then wb.WIR.AutoFilter.ShowAllData 
    lastRow = wb.WIR.Cells(Rows.Count, wb.COL_Address_code).End(xlUp).Row 

    Set dict = CreateObject("Scripting.Dictionary") ' <-- 
    addressList = wb.WIR.Range(wb.WIR.Cells(3, wb.COL_Address_code), wb.WIR.Cells(lastRow, wb.COL_Address_code)) 

    For Each addressItem In addressList 
     If Not dict.Exists(addressItem.Value) Then dict.Add addressItem.Value, addressItem.Value 
    Next 
    If dict.Count > 0 Then Me.address_combo.List = Application.Transpose(dict.toarray()) 
ElseIf ActiveSheet.Name = wb.S20FA.Name Then 
    If wb.CAL.FilterMode = True Then wb.CAL.AutoFilter.ShowAllData 
    lastRow = wb.CAL.Cells(Rows.Count, "A").End(xlUp).Row 
    Set cellRange = wb.CAL.Range("A8:A" & lastRow) 
    DoEvents 
    number_address = 0 
    For Each cell In cellRange 
     If Not dict.Exists(cell.Value) And _ 
      wb.CAL.Range("G" & cell.Row) <> "" And _ 
      Not IsError(wb.CAL.Range("K" & cell.Row).Value) And _ 
      wb.CAL.Range("K" & cell.Row).Value <> "" And wb.CAL.Range("K" & cell.Row).Value <> 0 And _ 
      ((wb.CAL.Range("Q" & cell.Row).Value <> "" And wb.CAL.Range("Q" & cell.Row).Value <> 0) Or _ 
      (wb.CAL.Range("W" & cell.Row).Value <> "" And wb.CAL.Range("W" & cell.Row).Value <> 0)) Then 

      dict.Add cell.Value, cell.Value 
     End If 
    Next cell 
    DoEvents 
    address_combo.List = dict.Items 
End If 
Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

Answer 2

Это решение, которое я поставил вместе с некоторыми предложениями A.S.H.

Я сохранил использование оригинала System.Collection.ArrayList, и теперь я использую его в обоих случаях.

Вместо того, чтобы перебирать лист и выполнять мои проверки для второго требования, теперь я копирую весь диапазон в память и проверяю его там.

С помощью этого метода я не достигаю скорости 0,03 секунды для полной, а не за несколько секунд до этого.

Если вы заметили какие-либо ошибки или улучшения, пожалуйста, оставьте мне комментарий, я все желаю попробовать новые решения.

Dim wb As Workbook: Set wb = ThisWorkbook 
Dim myArrayList As Object: Set myArrayList = CreateObject("System.Collections.ArrayList") 
Dim i, lastRow As Long 
Dim address() As String 
Dim number_address As Integer 
Dim cell As Range 
Dim addressList, addressItem 

Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 

Call wb.defineCols 
Call wb.defineSheets 

If ActiveSheet.Name = wb.PCHECK.Name Then 
    If wb.WIR.FilterMode = True Then wb.WIR.AutoFilter.ShowAllData 
    lastRow = wb.WIR.cells(Rows.count, wb.COL_Address_code).End(xlUp).Row 
    addressList = wb.WIR.Range(wb.WIR.cells(3, wb.COL_Address_code), wb.WIR.cells(lastRow, wb.COL_Address_code)) 
    With myArrayList 
     For Each addressItem In addressList 
      If Not .Contains(addressItem) Then .add addressItem 
     Next 
     .Sort 
     If .count > 0 Then Me.ComboBox1.List = Application.Transpose(myArrayList.toarray()) 
    End With 
ElseIf ActiveSheet.Name = wb.S20FA.Name Then 
    If wb.CAL.FilterMode = True Then wb.CAL.AutoFilter.ShowAllData 
    lastRow = wb.CAL.cells(Rows.count, "A").End(xlUp).Row 
    addressList = wb.CAL.Range("A8:W" & lastRow).value 
    With myArrayList 
     For i = LBound(addressList) To UBound(addressList, 1) 
      If Not .Contains(addressList(i, 1)) Then 
       If addressList(i, 7) <> "" Then 
        If Not IsError(addressList(i, 11)) And addressList(i, 11) <> "" And addressList(i, 11) <> 0 Then 
         If (addressList(i, 18) <> "" And addressList(i, 18) <> 0) Then 
          .add addressList(i, 1) 
         End If 
        End If 
       End If 
      End If 
     Next i 
     .Sort 
     If .count > 0 Then Me.ComboBox1.List = Application.Transpose(myArrayList.toarray()) 
    End With 
End If 

myArrayList.Clear 
Set myArrayList = Nothing