Question

我正在尝试找到一种将数据添加到Combobox的快速解决方案。

我有一张用于两张纸的用户表单，它会创建一个地址列表，具体取决于活动表，地址列表是从两张表中创建的。

下面是我目前拥有的代码，如果活动工作表名称= SCHECK.name，那么我使用System.Collection.ArrayList创建工作表WIR中唯一的排序值列表，该列表将添加到Combobox中。

如果活动工作表为S20FA，则从CAL创建列表。我想使用System Collection来创建它，因为它比我目前创建一个数组的解决方案要快得多，然后循环遍历数组并添加到Combobox。

问题是，在将地址添加到数组之前，我不确定如何使用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

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

Excel VBA系统集合数组列表

2 个答案: