vba makro für jüngstes datum je mitarbeiter

[hotzi]

hallo zusammen,

folg. code gibt mir das jüngst datum von a6 bis a36 aus. ich würde
gerne noch das jüngste datum bezogen auf einen mitarbeiter haben
wollen. die verschiedenen mitarbeiter werden in der spalte b bzw. b6
bis b36 geführt. wie muss ich den code erweitern.


Sub JungesDatum()
Dim rMax As Range
Dim i As Double
Dim groessteZahl As Date
groessteZahl = 0
For i = 6 To Sheets("Monatsstunden").UsedRange.Rows.Count
Set rMax =
Range("a6:a36").Find(CDate(Application.WorksheetFunction.Max(Range("a6:a36"))))
If rMax Is Nothing Then
MsgBox "Keine Werte vorhanden" '<-- ### Hier kann
sofort zur Funktion (Befüllen) geswitched werden
Else
'MsgBox rMax.Address
groessteZahl = rMax
MsgBox "jüngstes Datum " & groessteZahl
End If 'Schleifenende jüngstes Datum

Next
End Sub


danke für die hilfe klaus

[michlchen]

probiers mal damit...

ist halt nur für extrem lange listen ungeeignet, da ich per loop über
alle zellen in B gehe um herauszufinden, wann ein neuer name kommt.


Sub JungesDatum_Gruppe()

Sheets("Monatsstunden").Activate
Anfang = 6
Ende = ActiveSheet.UsedRange.Rows.Count
'oder
Ende = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

Range("A" & Anfang).Select
Range(Selection, Selection.End(xlToRight).End(xlDown)).Select
Selection.Sort Key1:=Range("B" & Anfang - 1), Order1:=xlAscending,
Key2:=Range("A" & Anfang - 1), Order2:=xlDescending

Range("B" & Anfang).Select
Name = ActiveCell.Value
Datum = ActiveCell.Offset(0, -1).Value
MsgBox ("Mindatum für " & Name & " ist: " & Datum)
Do Until Ende_Schleife = True
Do
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value <> Name
Name = ActiveCell.Value
Datum = ActiveCell.Offset(0, -1).Value
If Name <> "" Then MsgBox ("Mindatum für " & Name & " ist: " &
Datum)
If ActiveCell.Value = "" Then Ende_Schleife = True
Loop
End Sub