Zellensprung +4 nach unten
13.11.2013 21:15:27
Albert
ich hab hier im Forum diesen Code bekommen, der im ersten Durchgang nach einem Datum sucht und ich zweiten Durchgang einen Namen innerhalb der gefundenen Spalte.
Nun kommen wir zum Problem.
Von der gefundenen Zelle aus, soll der Cursor um vier Zellen nach unten wandern.
Doch wie stelle ich das letzte an? Bin am Verzweifeln
Sub Feedback_Zusatzschicht()
Dim rngDatum As Range, rngName As Range
Application.ScreenUpdating = False
'Feedback in die Zusatzschichtenübersicht geben, dass der Schichtleiter genehmigt hat.
Sheets("Zusatzschichtenübersicht").Select
With ZSVerwaltung
Set rngDatum = Cells.Find(What:=CDate(.TextBox3.Text), After:=ActiveCell, LookIn:= _
xlFormulas, _
lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Not rngDatum Is Nothing Then
Set rngName = rngDatum.EntireColumn.Find(What:=ZSVerwaltung.ListBox1.Value, _
After:=rngDatum, LookIn:= _
xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
End With
'Statusänderung von GELB zu GRÜN
ActiveCell(Selection.Row + 4, Selection.Column).Value = "1"
Application.ScreenUpdating = True
Sub Feedback_Zusatzschicht()
Dim rngDatum As Range, rngName As Range
Application.ScreenUpdating = False
'Feedback in die Zusatzschichtenübersicht geben, dass der Schichtleiter genehmigt hat.
Sheets("Zusatzschichtenübersicht").Select
With ZSVerwaltung
Set rngDatum = Cells.Find(What:=CDate(.TextBox3.Text), After:=ActiveCell, LookIn:= _
xlFormulas, _
lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Not rngDatum Is Nothing Then
Set rngName = rngDatum.EntireColumn.Find(What:=ZSVerwaltung.ListBox1.Value, _
After:=rngDatum, LookIn:= _
xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
End With
'Statusänderung von GELB zu GRÜN
ActiveCell(Selection.Row + 4, Selection.Column).Value = "1"
Application.ScreenUpdating = True
End Sub
End Sub
A.