2017-08-26 5 views
-5

Je suis en train de faire un bouton suivant et précédent pour afficher sur les zones de texte si j'ai plus d'un de la même valeur avec ce code, je ne peux obtenir la dernière valeur neGet suivante ou précédente valeur

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 

ce que je dois faire est de montrer la 1ère valeur et si la presse va à côté de la prochaine même valeur entrée dans la boîte de texte formulaire utilisateur 4

+0

Il est pas clair ce que vous signifier. S'il vous plaît clarifier ce que vous voulez dire et peut-être inclure une capture d'écran du formulaire d'utilisateur et/ou de la feuille de calcul afin que vous puissiez obtenir l'aide dont vous avez besoin –

Répondre

0

Vous devez arrêter votre recherche si quelque chose trouvé (Exit For à la fin de If- Block) et vous avez besoin de savoir ce qui a été trouvé en dernier, si quelque chose (stocker la valeur de i). Les plages Excel ont un .Findmethod que vous pouvez utiliser.

Essayez:

'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 

Utilisez des noms descriptifs pour les variables (par exemple: frmSearch au lieu de UserForm1 et txtColumn3 au lieu de TextBox2) et tiret rendre votre code facile à lire