Hi,
nee, das hält sich vom Aufwand her in Grenzen, folgt ja der gleichen Logik. Teste mal:
Public Sub Auswertung()
Dim lng_zeile As Long
Dim lng_letzte_zeile As Long
Dim dat_kleinstes_Datum As Date
Dim dat_groesstes_Datum As Date
Dim str_merkname As String
Dim lng_kleinstes_Kill As Long
Dim lng_groesstes_Missionen As Long
Dim lng_kleinstes_Missionen As Long
Dim obj_quelle As Worksheet
Dim obj_ziel As Worksheet
Dim lng_zeile_FND As Long
Dim lng_zeile_FND2 As Long
Dim lng_zeile_ziel As Long
lng_zeile = 2 ' Startzeile auf Blatt Übersicht
lng_zeile_FND = 2 ' Startzeile für Einfügen, auf 1 setzen, falls keine Überschriften _
vorhanden _
sind
lng_zeile_FND2 = 2
Set obj_quelle = Worksheets("Übersicht")
With obj_quelle
lng_letzte_zeile = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:M" & lng_letzte_zeile).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:= _
xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
str_merkname = .Cells(lng_zeile, 1)
dat_groesstes_Datum = DateSerial(Int(Left(.Cells(lng_zeile, 13), 4)), Mid(.Cells(lng_zeile, _
_
13), 5, 2), Right(.Cells(lng_zeile, 13), 2))
dat_kleinstes_Datum = DateSerial(Int(Left(.Cells(lng_zeile, 13), 4)), Mid(.Cells(lng_zeile, _
_
13), 5, 2), Right(.Cells(lng_zeile, 13), 2))
lng_groesstes_Kill = .Cells(lng_zeile, 3)
lng_kleinstes_Kill = .Cells(lng_zeile, 3)
lng_groesstes_Missionen = .Cells(lng_zeile, 5)
lng_kleinstes_Missionen = .Cells(lng_zeile, 5)
Do Until lng_zeile > lng_letzte_zeile
If str_merkname = .Cells(lng_zeile, 1) Then
If dat_groesstes_Datum DateSerial(Int(Left(.Cells(lng_zeile, 13), 4)), Mid(. _
Cells( _
lng_zeile, 13), 5, 2), Right(.Cells(lng_zeile, 13), 2)) Then
dat_kleinstes_Datum = DateSerial(Int(Left(.Cells(lng_zeile, 13), 4)), Mid(. _
Cells(lng_zeile, 13), 5, 2), Right(.Cells(lng_zeile, 13) _
, 2))
lng_kleinstes_Kill = .Cells(lng_zeile, 3)
lng_kleinstes_Missionen = .Cells(lng_zeile, 5)
End If
Else
' neuer Name
Set obj_ziel = Worksheets(CStr(.Cells(lng_zeile - 1, 2)))
If .Cells(lng_zeile - 1, 2) = "FND" Then
lng_zeile_ziel = lng_zeile_FND
Else
lng_zeile_ziel = lng_zeile_FND2
End If
With obj_ziel
.Cells(lng_zeile_ziel, 1) = str_merkname
.Cells(lng_zeile_ziel, 2) = lng_groesstes_Kill - lng_kleinstes_Kill
.Cells(lng_zeile_ziel, 3) = lng_groesstes_Missionen - lng_kleinstes_Missionen
End With
If .Cells(lng_zeile - 1, 2) = "FND" Then
lng_zeile_FND = lng_zeile_FND + 1
Else
lng_zeile_FND2 = lng_zeile_FND2 + 1
End If
str_merkname = .Cells(lng_zeile, 1)
dat_groesstes_Datum = DateSerial(Int(Left(.Cells(lng_zeile, 13), 4)), Mid(.Cells( _
_
lng_zeile, 13), 5, 2), Right(.Cells(lng_zeile, 13), 2))
dat_kleinstes_Datum = DateSerial(Int(Left(.Cells(lng_zeile, 13), 4)), Mid(.Cells( _
_
lng_zeile, 13), 5, 2), Right(.Cells(lng_zeile, 13), 2))
lng_groesstes_Kill = .Cells(lng_zeile, 3)
lng_kleinstes_Kill = .Cells(lng_zeile, 3)
lng_groesstes_Missionen = .Cells(lng_zeile, 5)
lng_kleinstes_Missionen = .Cells(lng_zeile, 5)
End If
lng_zeile = lng_zeile + 1
Loop
End With
End Sub
Gruß
Regina