Excel VBA System Collection Array Liste

Question

Ich versuche eine schnelle Lösung für das Hinzufügen von Daten in eine Combobox zu finden.

Ich habe ein Benutzerformular, das auf zwei Blättern verwendet wird, erstellt eine Liste von Adressen, abhängig von dem aktiven Blatt, wird die Adressliste aus einem von zwei Blättern erstellt.

Unten ist der Code, den ich derzeit habe, wenn der aktive Blattname = SCHECK.name dann verwende ich System.Collection.ArrayList, um die Liste der eindeutigen sortierten Werte von Blatt WIR zu erstellen, das der Combobox hinzugefügt wird.

Wenn das aktive Blatt S20FA ist, erstellen Sie die Liste aus CAL. Ich möchte die System-Sammlung verwenden, um dies zu erstellen, da es viel schneller ist, als die Lösung, die ich momentan habe, ein Array zu erstellen, dann das Array zu durchlaufen und der Combobox hinzuzufügen.

Das Problem damit ist, ich bin mir nicht sicher, wie die Überprüfungen, die ich mit System.Collection.ArrayList benötige, bevor die Adresse in das Array hinzugefügt wird.

Zusammen damit ist es möglich, System.Collection.ArrayList zu verwenden, um ein mehrdimensionales Array für die Verwendung mit mehrspaltigen Comboboxen zu erstellen?

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

Da Duplikate vermieden werden sollen, verwende besser eine Datenstruktur, die Duplikate verarbeiten kann. Scripting.Dictionary ist ein ausgezeichnetes Werkzeug für diese Art von Anwendungen; Es verweigert doppelte Schlüssel, so dass es eine saubere und eindeutige Liste in seinem .keys Array hat.

Im Folgenden wird der Code unter Verwendung der Wörterbuchdatenstruktur neu geschrieben. Probieren Sie es aus, um zu sehen, ob es die Geschwindigkeit verbessert. Beachten Sie, dass die Liste nicht sortiert ist, aber wenn die Geschwindigkeit verbessert wird, aber wir noch sortieren müssen, können wir später eine Sortierroutine hinzufügen.

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

Dies ist die Lösung, die ich mit etwas Hilfe von A.S.H Vorschläge zusammengestellt habe.

Ich habe die Verwendung des ursprünglichen System.Collection.ArrayList beibehalten und verwende es jetzt in beiden Fällen.

Anstatt das Blatt zu durchlaufen und meine Prüfungen für die zweite Anforderung durchzuführen, kopiere ich jetzt den gesamten Bereich in den Speicher und überprüfe ihn dort.

Mit dieser Methode erreiche ich keine Geschwindigkeiten von 0,03 Sekunden für vollständig statt zuvor ein paar Sekunden.

Wenn Sie irgendwelche Fehler oder Verbesserungen feststellen können, lassen Sie mich bitte einen Kommentar, ich bin alle Wege bereit, neue Lösungen auszuprobieren.

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