2017-08-26 26 views
-5

私は私が唯一の最後の値を取得することができ、このコードと同じ値 を複数持っている場合は、テキストボックスに表示する次と前のボタンを作成しようとしているだけ取得次または前の値

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

+0

を読み、あなたのコードを容易にするインデントそれは何明確ではありません平均。あなたが何を意味しているのかを明確にし、おそらくユーザーフォームやワークシートのスクリーンショットを含めて、必要なヘルプを得ることができます –

答えて

0

は、IF-の終わりに(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 

使用の記述変数の名前(例:代わりにTextBox2の代わりにUserForm1txtColumn3frmSearch)と

関連する問題