VBA Hilfe- max. Wert bei gleichen Vergleichswerten

Forumthread: VBA Hilfe- max. Wert bei gleichen Vergleichswerten

Peter

Hallo,
den auch mehrfach vorkommenden Werten in Spalte C sind in Spalte K
Datumswerte zugeordnet.
Bei mehrfach vorkommenden Werten soll nur der Maximalwert in Spalte A
Kopiert werden.
Falls die Erklärung verwirrend ist siehe Anlage. Die gelb hinterlegten
Zellen sind das Ziel der Prozedur.
https://www.herber.de/bbs/user/64227.xls


Sub MaxDatumGruppe1()
Dim iZeile As Long, LetzteZeile As Long
LetzteZeile = Range("C65536").End(xlUp).Row
For iZeile = 2 To LetzteZeile
If WorksheetFunction.CountIf(Range("C2:C" & iZeile), Cells(iZeile, 3)) = 1 And _
WorksheetFunction.Max(Range("K2:K" & iZeile), Cells(iZeile, 11)) Then
Cells(iZeile, 1) = WorksheetFunction.Max(Columns(11), Cells(iZeile, 11))
End If
Next iZeile
End Sub

Im voraus Danke
Peter

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

AW: VBA Hilfe- max. Wert bei gleichen Vergleichswerten

fcs

AW: VBA Hilfe- max. Wert bei gleichen Vergleichswerten

05.09.2009 02:46:12

fcs

Hallo Peter,
Hauptproblem in deiner Datei: In Spalte K steht das Datum als Text.
Dadurch haben Formeln Probleme den Zellinhalt auszuwerten bzw. in die Formeln müssen Funktionen zur Umwandlung von Text zu Datum/Zeit eingebaut werden.
Das Makro sollte also erst den Inhalt dieser Spalte in Excel-Zeit umwandeln. Dann kann man in Spalte A eine Matrix-Formel zur Berechnung einfügen und die Ergebnisse dann wieder durch Werte ersetzen.
Gruß
Franz

Sub MaxDatumGruppe1()
Dim LetzteZeile As Long, Zelle As Range
LetzteZeile = Cells(Rows.Count, 3).End(xlUp).Row
'Format in Spalten A und K setzen
Columns(1).NumberFormat = "DD.MM.YYYY hh:mm:ss"
Columns(11).NumberFormat = "DD.MM.YYYY hh:mm:ss"
'Text in Spalte K in Datum umwandeln
For Each Zelle In Range(Cells(2, 11), Cells(LetzteZeile, 11))
If Zelle = "" Then
Zelle.ClearContents
Else
Zelle.Value = DateValue(Zelle.Text) + TimeValue(Zelle.Text)
End If
Next
'Berechnungsformel in Spalte A2 eintragen und Formel durch Werte ersetzen
Cells(2, 1).FormulaArray = _
"=IF(ISBLANK(RC[2]),"""",IF(RC[10]=MAX(IF((RC[2]=R2C3:R" & LetzteZeile _
& "C3),R2C11:R" & LetzteZeile & "C11,0)),RC[10],""""))"
With Range(Cells(2, 1), Cells(LetzteZeile, 1))
'Formel kopieren
.FillDown
'Exit Sub 'Zeile von Bemerkung in Code wandeln, wenn die Formeln stehen bleiben sollen
'Formeln durch werte ersetzen
.Value = .Value
End With
'Leerstrings in Zellen löschen
For Each Zelle In Range(Cells(2, 1), Cells(LetzteZeile, 1))
If Zelle = "" Then Zelle.ClearContents
Next
End Sub

Beliebteste Forumthreads (12 Monate)

VBA Hilfe- max. Wert bei gleichen Vergleichswerten

Forumthread: VBA Hilfe- max. Wert bei gleichen Vergleichswerten

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread