Excel VBA系统集合数组列表
我正试图find一个快速的解决scheme，将数据添加到Combobox中。
我有一个在两张纸上使用的用户表单，它根据活动工作表创build一个地址列表，地址列表是从两个工作表之一创build的。
下面是我当前有的代码，如果活动工作表名称= SCHECK.name，那么我使用System.Collection.ArrayList来创build从工作表WIR添加到combobox中的唯一sorting值的列表。
如果活动工作表是S20FA，则从CAL创build列表。 我想使用系统集合来创build它，因为现在创build一个数组的解决scheme要快得多，然后循环遍历数组并添加到combobox中。
这个问题是，我不知道如何执行我需要与System.Collection.ArrayList ，地址添加到数组之前的检查。
除此之外，是否可以使用System.Collection.ArrayList创build一个multidimensional array，以便与多列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
既然你想避免重复，最好使用一个旨在处理重复的数据结构。 Scripting.Dictionary是这类应用程序的优秀工具; 它会拒绝重复的密钥，所以它的.keys数组中会有一个干净而唯一的列表。
下面是使用字典数据结构重写代码。 试试看看它是否提高了速度。 请注意，列表不是sorting的，但是如果速度得到改善，但仍然需要sorting，我们可以稍后添加一个sorting例程。
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
这是我在ASHbuild议帮助下的解决scheme。
我一直使用原来的System.Collection.ArrayList ，现在在两个实例中都使用它。
而不是循环表单，并执行我的检查第二个要求，我现在将整个范围复制到内存中，并在那里检查。
用这种方法，我不能完成0.03秒的速度而不是几秒钟。
如果你能注意到任何错误或改进，请给我留言，我都愿意尝试新的解决scheme。
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