vba 系统集合阵列列表

System Collection Array List

提问by atame

I am trying to add data into a Combobox.

我正在尝试将数据添加到组合框中。

I have a userform that is used on two sheets. It creates a list of addresses. Depending on the active sheet, the address list is created from one of two sheets.

我有一个在两张纸上使用的用户表单。它创建一个地址列表。根据活动工作表，地址列表是从两个工作表之一创建的。

If the active sheet name = SCHECK.name then I use System.Collection.ArrayListto create the list of unique sorted values from sheet WIR, that is added to the Combobox.

如果活动工作表名称 = SCHECK.name，则我使用工作System.Collection.ArrayList表 WIR 创建唯一排序值的列表，该列表将添加到组合框。

If the active sheet is S20FA, then I create the list from CAL. I would like to use the System Collection, to create this as it is much faster than the solution I have creating an array, then looping over the array and adding to the Combobox.

如果活动工作表是 S20FA，则我从 CAL 创建列表。我想使用系统集合来创建它，因为它比我创建数组的解决方案快得多，然后循环遍历数组并添加到组合框。

The problem is, how to perform the checks that I need with System.Collection.ArrayList, before the address is added into the array.

问题是，如何System.Collection.ArrayList在将地址添加到数组之前执行我需要的检查。

Along with this, is it possible to use System.Collection.ArrayListto create a multi-dimensional array fo use with multi-column Comboboxes?

除此之外，是否可以使用System.Collection.ArrayList创建用于多列组合框的多维数组？

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

回答by A.S.H

Since you want to avoid duplicates, better use a data structure that is designed to handle duplicates. Scripting.Dictionaryis an excellent tool for this kind of applications; it denies duplicate keys so it will have a clean and unique list in its .keysarray.

由于您想避免重复，最好使用旨在处理重复的数据结构。Scripting.Dictionary是此类应用程序的绝佳工具；它拒绝重复键，因此它的.keys数组中将有一个干净且唯一的列表。

Below is a rewrite of the code using the dictionary data structure. Try it to see if it improves the speed. Note that the list is not sorted, but if speed is improved but we still needs sorting, we can add a sorting routine later.

下面是使用字典数据结构重写代码。试试看能不能提高速度。注意列表没有排序，但是如果速度提高了但我们仍然需要排序，我们可以稍后添加一个排序例程。

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

回答by atame

this is the solution that I have put together with some help from A.S.H suggestions.

这是我在 ASH 建议的帮助下整理的解决方案。

I have kept the use of the original System.Collection.ArrayList, and am now using it in both instances.

我一直使用原始的System.Collection.ArrayList，现在在这两种情况下都使用它。

Rather than looping over the sheet and performing my checks for the second requirement, I am now copying the entire range into memory and checking it there.

我现在没有遍历工作表并检查第二个要求，而是将整个范围复制到内存中并在那里检查。

With this method, I am now achieving speeds of 0.03 seconds to complete rather than a few seconds previously.

使用这种方法，我现在可以实现 0.03 秒的完成速度，而不是之前的几秒。

If you can notice any mistakes or improvements, then please leave me a comment, I am always willing to try new solutions.

如果您发现任何错误或改进，请给我留言，我总是愿意尝试新的解决方案。

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