获取一个或下一个值

Question

我试图让一个和上一个按钮，显示在文本框，如果我有这个代码相同的值 我只能得到最后一个值超过一个只有

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 

什么，我需要做的是显示第一个值，如果按下一步进入用户表单文本框中输入的下一个相同的值4

Answer 1

你必须在任何─的结束时，如果发现东西阻止你的搜索（Exit For块），并且您需要知道上次找到的内容，如果有的话（存储值为i）。

Excel范围有.Findmethod您可以使用。

尝试：

'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 

使用变量描述性的名字（如：frmSearch，而不是UserForm1 和txtColumn3代替TextBox2）和缩进，使得代码易于阅读