獲取一個或下一個值

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）和縮進，使得代碼易於閱讀