Setting Up Find Next and Find Previous Buttons in

2019-08-30 02:52发布

I'm having trouble getting my userform in Excel 2007 to autofill the form. It works fine for the first entry, but I can't get the Next button to pull up the next entry that matches the search criteria.

The userform is to enter participant information, and I want the user to be able to use the userform to search through all entries that match the search criteria, so if there's participants with the same name that they can find the right one.

Here's what I have so far;

Private Sub FindButton_Click() ' find entry

    Set r = Sheet4.Range("B:B").Find(What:=Firstname.Text, lookat:=xlWhole, MatchCase:=False)

    If Not r Is Nothing Then
        '// Get value in cell r.row, column 2 into textbox2
        Lastname.Text = Sheet4.Cells(r.Row, 3).Value
        age.Text = Sheet4.Cells(r.Row, 4).Value
        Gender.Text = Sheet4.Cells(r.Row, 5).Value
        Grade.Text = Sheet4.Cells(r.Row, 6).Value
        Discepline.Text = Sheet4.Cells(r.Row, 7).Value
        shoesize.Text = Sheet4.Cells(r.Row, 8).Value
        HT.Text = Sheet4.Cells(r.Row, 9).Value
        Weight.Text = Sheet4.Cells(r.Row, 10).Value
        Skier.Text = Sheet4.Cells(r.Row, 11).Value
        Ability.Text = Sheet4.Cells(r.Row, 12).Value
        Lessons.Value = Sheet4.Cells(r.Row, 13).Value
        Rentals.Value = Sheet4.Cells(r.Row, 14).Value
        LiftPass.Value = Sheet4.Cells(r.Row, 15).Value
        Helmet.Value = Sheet4.Cells(r.Row, 16).Value
     End If

    If Firstname = "" Then MsgBox "Enter first name!"


End Sub


Private Sub nxt_Click() 'Commandbutton "find next"
    Dim Rng As Range
    Dim Found1 As Boolean

    If Found1 = False Then
        Set Rng = Columns(2).Find(Me.Firstname.Value, Rng, xlValues, xlWhole, xlByRows)
        Found1 = True
    Else
        Set Rng = Columns(2).FindNext(Rng)
    End If

    If Not Rng Is Nothing Then
        Lastname.Text = Sheet4.Cells(r.Row, 3).Value
        age.Text = Sheet4.Cells(r.Row, 4).Value
        Gender.Text = Sheet4.Cells(r.Row, 5).Value
        Grade.Text = Sheet4.Cells(r.Row, 6).Value
        Discepline.Text = Sheet4.Cells(r.Row, 7).Value
        shoesize.Text = Sheet4.Cells(r.Row, 8).Value
        HT.Text = Sheet4.Cells(r.Row, 9).Value
        Weight.Text = Sheet4.Cells(r.Row, 10).Value
        Skier.Text = Sheet4.Cells(r.Row, 11).Value
        Ability.Text = Sheet4.Cells(r.Row, 12).Value
        Lessons.Value = Sheet4.Cells(r.Row, 13).Value
        Rentals.Value = Sheet4.Cells(r.Row, 14).Value
        LiftPass.Value = Sheet4.Cells(r.Row, 15).Value
        Helmet.Value = Sheet4.Cells(r.Row, 16).Value
    Else
        MsgBox "No Participant Found."
    End If
End Sub

标签: excel vba
1条回答
Evening l夕情丶
2楼-- · 2019-08-30 03:48

Here's how I would probably do something like this - as a general approach. (untested but you should get the idea...)

Option Explicit

Dim hits As Collection 'all matches as a collection of rows
Dim hitsPos As Long    'current position in matches

Sub FindButton_Click()

    Me.nxt.Enabled = False
    Set hits = FindAll(Sheet4.Range("B:B"), Firstname.Text)
    If hits.Count > 0 Then
        Me.nxt.Enabled = hits.Count > 1 'enable/disable "next" button
        hitsPos = 1
        LoadRow hits(hitsPos)
    Else
        MsgBox "No matches for '" & Firstname.Text & "'"
    End If
End Sub

Sub nxt_Click()
    If hitsPos < hits.Count Then
        hitsPos = hitsPos + 1
        LoadRow hits(hitsPos)
        Me.nxt.Enabled = hits.Count > hitsPos 'disable if last hit
    End If
End Sub

'load a record from the sheet
Sub LoadRow(rw As Range)
    With rw
        Firstname.Text = .Cells(2).Value
        Lastname.Text = .Cells(3).Value
        age.Text = .Cells(4).Value
        'etc etc
    End With
End Sub

'save a record to the sheet
Sub SaveRow(rw As Range)
    With rw
        .Cells(2).Value = Firstname.Text
        .Cells(3).Value = Lastname.Text
        .Cells(4).Value = age.Text
        'etc etc
    End With
End Sub

'find all matching rows and return as a collection object
Public Function FindAll(rng As Range, val As String) As Collection
    Dim rv As New Collection, f As Range
    Dim addr As String

    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
    If Not f Is Nothing Then addr = f.Address()

    Do Until f Is Nothing
        rv.Add f.EntireRow '<< add the whole row...
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do
    Loop

    Set FindAll = rv
End Function
查看更多
登录 后发表回答