组合框和命令按钮从 VBA 到 excel 的加载时间缓慢

Question

我创建了一个 excel 模板，这样我就可以输入名称并从下拉列表中拉出，然后在单击 时用名称填充列中的下一个空单元格。 它有效，但速度很慢。 我使用了一些我在网上找到的技巧来帮助加快速度，但没有一个能显着提高速度。 我想我可能需要将列表存储在基于 memory 的数组中，该数组仅在工作簿打开时运行 - 我相信扫描列表以查找下拉列表的相关选项会减慢进程，但我不确定这或如何做到这一点。

Public Sub ListRange_Var()

With Me.ComboBox1

.List = Worksheets("Picklist Options").Range("A3",Worksheets("Picklist Options").Cells(Rows.Count, "A").End(xlUp)).Value

.ListRows = WorksheetFunction.Min(10, .List)

.Dropdown

.LinkedCell = "FWDCalendar!B2"

IF Len(.Text) Then

For I = .ListCount - 1 To 0 Step -1

If InsStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i

Next

.Dropdown

End IF

End With

End Sub


Private Sub ComboBox1_Change()

Dim I as Long

If Not ISArrow Then 

Call ListRange_Var

End Sub



Private Sub ComboBox1_KeyDown(ByVal KeyCode as MS.Forms.ReturnInteger, ByVal Shift As Integer)

IsArrow = KeyCode = vbKeyUp) or (KeyCode = vbKeyDown)

If KeyCode = vbKeyReturn Then Me.ComboBox1.List = Worksheets("Picklist Options").Range("A3", Worksheets("Picklist Options").Cells(Rows.Count, "A").End(xlUp)).Value

End Sub

Answer 1

您可以试试这个，它在将列表分配给 combobox 之前过滤列表。即使有 15k 个项目，我也看到了良好的性能。

这是使用 ColA 中的列表，combobox 在 ColB 中的同一个工作表上（使用 Seelction_change 事件定位在单元格选择上）

代码在工作表模块中。 当它四处移动时，我确实看到了组合的一些“重影”，但这是另一个问题。

Option Explicit

Dim IsArrow As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range
    If Target.CountLarge > 1 Then Exit Sub
    Set rng = Application.Intersect(Target, Me.Columns("B"))
    
    Application.ScreenUpdating = False
    With Me.ComboBox1
        If Not rng Is Nothing Then
            
            Debug.Print .LinkedCell
            .Visible = False
            DoEvents
            .Visible = True
            DoEvents
            .LinkedCell = "'" & rng.Parent.Name & "'!" & rng.Address(False, False)
            .Top = rng.Top
            .Left = rng.Left
            .Text = ""
            ListRange_Var
            .Activate
         Else
            .Left = 500
            .LinkedCell = ""
        End If
    End With
End Sub

Public Sub ListRange_Var()
    Dim i As Long
    With Me.ComboBox1
        .List = FilteredList(.Text)
        .ListRows = WorksheetFunction.Min(10, .List)
        .DropDown
    End With
End Sub


Private Sub ComboBox1_Change()
    If Not IsArrow Then ListRange_Var
End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    If KeyCode = vbKeyReturn Then Me.ComboBox1.List = FilteredList
End Sub

'return an array of items, potentially filtered according to
'  user-entered value in combobox
Function FilteredList(Optional v As String = "")
    Dim arr, arrOut, i  As Long, n As Long
    With Worksheets("Picklist Options")
        arr = .Range("A3", .Cells(.Rows.Count, "A").End(xlUp)).Value
    End With
    If Len(v) = 0 Then
        FilteredList = arr
    Else
        arr = Application.Transpose(arr)
        ReDim arrOut(LBound(arr) To UBound(arr))
        n = LBound(arr) - 1
        For i = LBound(arr) To UBound(arr)
            If InStr(1, arr(i), v, vbTextCompare) > 0 Then
                n = n + 1
                arrOut(n) = arr(i)
            End If
        Next i
        If n > LBound(arr) - 1 Then
            ReDim Preserve arrOut(LBound(arrOut) To n)
            FilteredList = arrOut
        Else
            FilteredList = Array("")
        End If
    End If
End Function