excel动态下拉搜索列表中的性能问题答案

【问题标题】：Performance issue in Dynamic Dropdown Search list in excelexcel动态下拉搜索列表中的性能问题
【发布时间】：2017-09-21 12:17:13
【问题描述】：

我已经创建了下拉列表，它从现有数据（如谷歌搜索）中提供建议。我已经按照link 中提到的步骤获得了预期的结果。我已将过程更改为 VBA 代码，因为具有数据的列范围可以随时间增加（添加新条目时，公式将动态插入范围）。现在的问题是，由于该列有超过 20 000 行，因此在按下某个键时显示建议需要更多时间。

我需要以表单的形式从用户那里获取数据并将其存储在 Excel 工作表中。表单将主要包含下拉搜索列表，其中搜索列表具有近 10 万个值。搜索列表保存在不同的 Excel 表中，并且列表的大小每周都会增加。可以使用 Excel VBA 来实现吗？如果可以，如何提高excel性能？

我在 Windows Server 2008 操作系统中使用 Excel 2010。我可以将数据加载到 SQL Server 表中。如果这在 Excel 中是不可能的，有什么方法可以使用 SQL Server 来实现这一点？

【问题讨论】：

标签： performance excel sql-server-2012 frontend vba

【解决方案1】：

我不知道性能，但试试以下。您的数据应该在表“db”中，从第 2 行开始。安装了一个组合框，我在用户窗体中放置了一个文本框 (TextBox1) 和一个列表 (ListBox1)。

Private Sub TextBox1_Change()
    Dim v As String
    Dim YourInput As String
    Dim iIdx As Long
    Dim CharNumber As Integer

    YourInput = TextBox1.Text

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    ListBox1.Clear

    lLastRow = Worksheets("db").Cells(3, 1).End(xlDown).Row
    CharNumber = Len(YourInput)

    For iIdx = 2 To lLastRow
        v = Worksheets("db").Cells(iIdx, 1).Text
        If LCase(Left(v, CharNumber)) = LCase(YourInput) Then
            ListBox1.AddItem v
        End If
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Private Sub ListBox1_Click()
    MsgBox ("Your selection: " & ListBox1.Text)
    'do your stuff
End Sub

【讨论】：

感谢您的回答 :) 但我仍然看到性能问题。按下某个键时，列表框至少需要 5 到 10 秒才能更新。

【解决方案2】：

我无法解决你假装的问题。我能够相当快地根据输入填写一个列表。但是，代码会在字符串中的任何位置找到您的输入，而不是在开头。根据您的数据，以下代码可能会对您有所帮助，或者您可以重新编写它以满足您的需求。同样，数据应该在工作表“db”中，从第 2 行开始，并且在 UserForm 中有一个文本框 (TextBox1) 和一个列表 (ListBox1)。

Private Sub UserForm_initialize()
    Dim lLastRow As Long

    'Get last row of data
    lLastRow = Worksheets("db").Cells(3, 1).End(xlDown).Row
    ReDim DirArray(1 To 1)
    j = 1

    'Add all the data to an Array (DirArray)
    For i = 3 To lLastRow
        ReDim Preserve DirArray(1 To j)
        DirArray(UBound(DirArray)) = Worksheets("db").Cells(i, 1).Value
        j = j + 1
    Next
End Sub

Private Sub TextBox1_Change()
    Dim YourInput As String

    YourInput = TextBox1.Text

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    ListBox1.Clear
    LArray = Array()

    LArray = Filter(DirArray, YourInput, True, vbTextCompare)

    ListBox1.List = LArray

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    End Sub

Private Sub ListBox1_Click()
    MsgBox ("Your selection: " & ListBox1.Text)
    'do your stuff
End Sub

【讨论】：

【解决方案3】：

我在我的 excel 应用程序中做了类似于谷歌搜索的事情。我的代码在最后一次击键后等待 2 秒，然后运行另一张表以获得接近匹配。这样它在打字时就不会通过数据库运行..

Wait until user has stopped typing in ComboBox to run macro (VBA)

有人建议我真的看看这篇文章，但这对我的特殊挑战没有帮助。

【讨论】：