excel - 系统集合数组列表

Question

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

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

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

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

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

除此之外，是否可以使用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

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