VBA用戶窗體ListBox和TextBox

Question

我有以下子代碼可根據三個條件找到一個單元格。

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直到語句有關。

Answer 1

您最好使用Find函數，並遍歷“ A”列中的所有Find結果（以防與TextBox1.Value有多個匹配項），直到您還能夠找到與ListBox1.Value和ListBox2.Value匹配的項ListBox2.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