2017-08-26 5 views
-5

Ich versuche, eine nächste und vorherige Taste, um auf Textfelder zu zeigen, wenn ich mehr als eine von den gleichen Wert haben mit diesem Code, den ich nur den letzten Wert nurGet nächsten oder vorherigen Wert

Set sh = ThisWorkbook.Sheets("Outage") 

With sh 
For i = 1 To 50 
If (InStr(1, Cells(i, 6), UserForm1.TextBox4.Text, vbTextCompare) > 0) Then 
outage.TextBox1.Text = .Cells(i, 1) 
outage.TextBox2.Text = .Cells(i, 3) 
outage.TextBox9.Text = .Cells(i, 6) 
outage.TextBox3.Text = .Cells(i, 9) 
outage.TextBox4.Text = .Cells(i, 10) 
outage.TextBox5.Text = .Cells(i, 11) 
outage.TextBox6.Text = .Cells(i, 14) 
outage.TextBox7.Text = .Cells(i, 15) 
outage.TextBox8.Text = .Cells(i, 16) 
End If 
Next 

End With 
bekommen

, was ich tun muß, ist den ersten Wert anzuzeigen und wenn drücken, um zum nächsten Wert geht als nächstes gleiche in Benutzerformular Textfeld eingegeben 4

+0

Es ist nicht klar, was Sie bedeuten. Bitte erläutern Sie, was Sie meinen und fügen Sie vielleicht einen Screenshot des Benutzerformulars und/oder des Arbeitsblatts bei, damit Sie die Hilfe erhalten, die Sie benötigen –

Antwort

0

Sie haben Ihre Suche zu stoppen, wenn etwas gefunden (Exit For am Ende der If- Block) und Sie müssen wissen, was zuletzt gefunden wurde, wenn überhaupt (speichern Sie den Wert i).

Excel-Bereiche haben eine .Findmethod, die Sie verwenden können.

Versuchen:

'put this code in UserForm1 module 
Private rngLastFound As Excel.Range 'Modul var for last found, is nothing at start, needs to be on top of module after OPTIONs 

Private Sub ButtonForward_Click() 
    On Error GoTo myError: 

    Dim sh As Excel.Worksheet 
    Dim rngFound As Excel.Range 

    Set sh = ThisWorkbook.Worksheets("Outage") ' Set sheet 

    Set rngFound = fctFindValue(UserForm1.TextBox4.Text, sh, xlNext) ' xlPrevious for back 

    If rngFound Is Nothing Then 
     MsgBox "Nothing found!" 
     Exit Sub 
    End If 
    populateTextboxes sh, rngFound.Row 
Exit Sub 

myError: 
    MsgBox "Error: " & Err.Number & " " & Err.Description 

End Sub 

Private Sub ButtonBackward_Click() 
    On Error GoTo myError: 

    Dim sh As Excel.Worksheet 
    Dim rngFound As Excel.Range 

    Set sh = ThisWorkbook.Worksheets("Outage") ' Set sheet 

    Set rngFound = fctFindValue(UserForm1.TextBox4.Text, sh, xlPrevious) 

    If rngFound Is Nothing Then 'No result 
     MsgBox "Nothing found!" 
     Exit Sub 
    End If 

    populateTextboxes sh, rngFound.Row 
Exit Sub 

myError: 
    MsgBox "Error: " & Err.Number & " " & Err.Description 

End Sub 

Private Function fctFindValue(ByVal strSearch As String, _ 
    ByVal sh As Excel.Worksheet, _ 
    ByVal direction As Excel.XlSearchDirection) As Excel.Range 
    On Error GoTo myError 

    Dim rngFind As Excel.Range 
    Dim lngLastRow As Long 
    Dim lngSearchCol As Long 

    lngSearchCol = 4 ' Set search column 

    With sh 
     lngLastRow = .Cells(.Rows.Count, lngSearchCol).End(xlUp).Row 'last row of serarch column 
     If rngLastFound Is Nothing Then 
      Set rngLastFound = .Cells(1, lngSearchCol) 'Set rngLastFound to first cell on first search 
     End If 

     Set rngFind = .Range(.Cells(2, lngSearchCol), .Cells(lngLastRow, lngSearchCol)) _ 
      .Find(strSearch, rngLastFound, SearchDirection:=direction, LookIn:=xlValues) 'search 
    End With 
     Set rngLastFound = rngFind ' update last found cell 
     Set fctFindValue = rngFind 
Exit Function 

myError: 
    MsgBox "Error: " & Err.Number & " " & Err.Description 

End Function 

Private Sub populateTextboxes(ByVal sh As Excel.Worksheet, ByVal lngRow As Long) 
    On Error GoTo myError 
    Dim i As Long 

    i = lngRow 'old counter i can be replaced by lngRow 

    With sh 
     outage.TextBox1.Text = .Cells(i, 1) 
     outage.TextBox2.Text = .Cells(i, 3) 
     outage.TextBox9.Text = .Cells(i, 6) 'use more descriptive name for TextBox9 (txtColumn6 as it refers to Column 6 of sheet 
     outage.TextBox3.Text = .Cells(i, 9) 
     outage.TextBox4.Text = .Cells(i, 10) 
     outage.TextBox5.Text = .Cells(i, 11) 
     outage.TextBox6.Text = .Cells(i, 14) 
     outage.TextBox7.Text = .Cells(i, 15) 
     outage.TextBox8.Text = .Cells(i, 16) 
    End With 

    Exit Sub 

myError: 
    MsgBox "Error: " & Err.Number & " " & Err.Description 

End Sub 

'clear last found on change of searchstring 
Private Sub TextBox4_Change() 
    If Not rngLastFound Is Nothing Then 
     Set rngLastFound = Nothing 
    End If 
End Sub 

Verwenden beschreibende Namen für Variablen (zB: frmSearch statt UserForm1 und txtColumn3 statt TextBox2) und indent Ihren Code leicht zu lesen sind

Verwandte Themen