VBA，需要帮助，我的代码输出生成时间太长

Question

我在sheet("DATA")中有一个数据列表，在BI列中有ID号列表，在CI列中有名称列表，当我在textbox1中输入ID号时，现在在我的用户窗体中。那么combobox2将填充所有具有相同ID号的名称。

我的代码运行良好，但是我的问题是生成combobox2列表的时间。我需要一种可以使其更快的方法。

这里是我的代码：

Sub cmbo2()
    Dim i as long, lastrow as long
    lastrow = Sheets("DATA").Range("B" & Rows.Count).End(xlUp).Row

    For i = 2 to lastrow
        If Sheets("DATA").Cells(i,"B").Value=(Textbox1) Or Sheets("DATA").Cells(i,"B"),Value=Val(Texbox1) Then
            ComboBox2.AddItem Sheets("DATA").Cells(i,"C").Value
        End if
    Next
End sub

我正在使用keycode = 13输入

Private Sub Textbox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        ComboBox2.Clear
        Call cmbo2
        ComboBox2.DropDown
        ComboBox2.SetFocus
    End If
End Sub

新的sub cmbo2代码

Sub cmbo2()
    Dim i as variant

    With worksheets("DATA")
        i = application.Match(CStr(TextBox1),.Columns(2),0)

        If IsError(i) Then _
          i = Application.Match(CLng(TextBox1),.Column(2),0)

        If Not IsError(i) Then _
          ComboBox2.AddItem.Sheets("DATA").Cells(i,"C").Value
    End With
End Sub

但是仍然存在问题。 combobox2仅填充一个名称，即使该ID中有很多名称也是如此。 我想用具有相同ID的所有名称填充combobox2。 我使用的ID不是唯一的。每个ID由2个或更多名称使用。

Answer 1

这应该快一点。 您是否缺少代码以清除列表中的先前值？

编辑：已修复并经过测试

Sub cmbo2()
    Dim i As Long, arr

    With ThisWorkbook.Sheets("DATA")
        arr = .Range(.Range("B2"), .Cells(Rows.Count, 2).End(xlUp).Offset(0, 1)).Value
    End With

    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = Me.TextBox1.Text Or _
           arr(i, 1) = Val(Me.TextBox1.Text) Then
            ComboBox2.AddItem arr(i, 2)
        End If
    Next

End Sub

Answer 2

不要循环。

Sub cmbo2()
    dim i as variant
    with workSheets("DATA")
        i = application.match(cstr(Textbox1), .columns(2), 0)
        if iserror(i) then _
            i = application.match(clng(Textbox1), .columns(2), 0)

        if not iserror(i) then _
            ComboBox2.AddItem .Cells(i, "C").Value
    end with
End sub

一旦找到匹配项，您自己的代码可能会受益于Exit For，但application.match总是比遍历行更快。

Answer 3

单击文本框中的Enter后，将填充组合框。如果首选，也可以在命令按钮中使用它。首先，它会过滤B列，将数据放置在新位置，然后将新范围用于组合框

过滤时可能没有结果吗？

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim LstRw As Long, sh As Worksheet, Frng As Range

    If KeyCode = vbKeyReturn Then
        s = ActiveSheet.Name
        Set sh = Sheets("Data")

        With sh
            .Range("B:B").AutoFilter Field:=1, Criteria1:=Me.TextBox1
            .Range("Y:Y").Clear
            .Range("C2:C" & .Cells(.Rows.Count, "C").End(xlUp).Row).Copy .Range("Y1")    'copy filtered data to another location
            LstRw = .Cells(.Rows.Count, "Y").End(xlUp).Row
            Set Frng = .Range("Y1:Y" & LstRw)
            Me.ComboBox1.Clear
            Me.ComboBox1.List = Frng.Value
            .AutoFilterMode = False
        End With
    End If
End Sub

-

您还可以使用组合框而不是文本框，该组合框只会填充唯一项 如果要使用组合框而不是文本框。 创建一个新的组合框，假设该组合框将被命名为combobox2 然后，在userform初始化事件中，您可以在显示userform时填充combobox2，这样，您将始终选择B列中的实际内容。 然后，您可以使用combobox2_change事件填充combobox1。

这是两个代码。

Private Sub UserForm_Initialize()
    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant

    Set sh = ThisWorkbook.Sheets("Data")
    Set Rng = sh.Range("B2:B" & sh.Cells(sh.Rows.Count, "B").End(xlUp).Row)
    Set cUnique = New Collection

    On Error Resume Next
    For Each Cell In Rng.Cells
        cUnique.Add Cell.Value, CStr(Cell.Value)
    Next Cell
    On Error GoTo 0

    For Each vNum In cUnique
        Me.ComboBox2.AddItem vNum

    Next vNum
End Sub


Private Sub ComboBox2_Change()
    Dim LstRw As Long, sh As Worksheet, Frng As Range

    s = ActiveSheet.Name
    Set sh = Sheets("Data")

    With sh
        .Range("B:B").AutoFilter Field:=1, Criteria1:=Me.ComboBox2
        .Range("Y:Y").Clear
        .Range("C2:C" & .Cells(.Rows.Count, "C").End(xlUp).Row).Copy .Range("Y1")    'copy filtered data to another location
        LstRw = .Cells(.Rows.Count, "Y").End(xlUp).Row
        Set Frng = .Range("Y1:Y" & LstRw)
        Me.ComboBox1.Clear
        Me.ComboBox1.List = Frng.Value
        .AutoFilterMode = False
    End With

End Sub