Настройка Find Next и Find Previous Buttons в VBA

Question

У меня проблемы с получением пользовательской формы в Excel 2007 для автозаполнения формы.Он отлично работает для первой записи, но я не могу заставить кнопку «Далее» вызвать следующую запись, которая соответствует критериям поиска.

Пользовательская форма должна вводить информацию об участнике, и я хочу, чтобы пользователь былвозможность использовать пользовательскую форму для поиска по всем записям, которые соответствуют критериям поиска, поэтому, если есть участники с одинаковыми именами, они могут найти правильного.

Вот что у меня есть;

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

Answer 1

Вот как я бы, вероятно, сделал что-то подобное - в качестве общего подхода.(не проверено, но вы должны понять ...)

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