我正在尝试将数据添加到组合框中。
我有一个在两张纸上使用的用户表单。它创建一个地址列表。根据事件工作表,地址列表是从两个工作表之一创建的。
如果事件工作表名称 = 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
最佳答案
由于您想避免重复,因此最好使用旨在处理重复的数据结构。 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
关于excel - 系统集合数组列表,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/41892843/