VBA 用户窗体列表框和文本框

VBA Userform ListBox and TextBox

我有以下子项可以根据三个条件查找单元格。

Private Sub FindEstimate_Click()

Dim i As Long

i = 5
Do
    If Cells(i, 1) = TextBox1 And Cells(i, 6) = ListBox1 And Cells(i, 9) =  ListBox2 Then
        Cells(i, 1).Select
    End If
    i = i + 1
Loop Until Cells(i, 1) = TextBox1 And Cells(i, 6) = ListBox1 And Cells(i, 9) = ListBox2

End Sub

它根本不起作用,我怀疑它与 Loop Until 语句有关。

您最好使用 Find 函数,循环遍历 "A" 列中的所有 Find 结果(以防 TextBox1.Value 有多个匹配项),直到您还可以找到 ListBox1.ValueListBox2.Value 的匹配项。

为此,您将使用 Do <-> Loop While Not FindRng Is Nothing And FindRng.Address <> FirstAddres 循环。

代码

Option Explicit

Private Sub FindEstimate_Click()

Dim Rng As Range
Dim FindRng As Range
Dim FirstRng As Range
Dim FirstAddress As String


Set Rng = Range("A5:A" & Cells(Rows.Count, "A").End(xlUp).Row)

With Rng
    Set FindRng = .Find(what:=Me.TextBox1.Value, LookIn:=xlValues, _
                        lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)

    If Not FindRng Is Nothing Then ' find was successful
       ' Set FirstRng = FindRng
        FirstAddress = FindRng.Address

        Do
            If FindRng.Offset(, 5).Value = Me.ListBox1.Value And FindRng.Offset(, 8).Value = Me.ListBox2.Value Then
                FindRng.Select ' <-- not sure why you need to select it
                Exit Do
            End If
            Set FindRng = .FindNext(FindRng)
        Loop While Not FindRng Is Nothing And FindRng.Address <> FirstAddress

    Else ' Find faild to find the value in TextBox1
        MsgBox "Unable to find " & Me.TextBox1.Value & " at column A"
    End If
End With

End Sub