Zeile rot färben bei 2 Bedinungen

Hallo Gemeinde,
ich habe wiedermal ein kleines Problem.
Und zwar habe ich wenn sich einige erinnern können jetzt meine Daten nach größer/gleich 3 usw. aufbereitet, leerzeilen für die Veranschaulichung usw. eingefügt und meine Rechnungen gemacht.
Jetzt ist mir aufgefallen, dass manche Monate doppelte Werte haben, zum Beispiel ich habe jetzt Datumsangaben in Spalte A und ich habe 2x 2007-11-01 aber mit jeweils anderen Werten. Die fälle müssen geprüft werden, daher möchte ich mit ein Makro durch alle Tabellenblätter jagen der prüfen soll ob es fälle gibt in dem es mehr als 12 Monate bzw. Zeilen gibt bei der Bildung von SUMs. Also wenn man den Jahreswert einer Menge bildet das SUMs durch eine Zahl größer 12 geteilt wird bevor man es mit 12 multipliziert, dann hätte ich die Fälle abgefangen wenn ich zwar 12 Monate habe aber in den 12 Monatswerten sich ein Monat doppelt vorkommt.
Da der Bereich der Bildung von SUMs zwischen minimal 3 bis eben größer 12 variieren kann und dabei sich Datumswerte auch wiederholen könnten muss noch der Fall abfangen werden ob je berechnungsbereich sich ein Datum wiederholt.
Ein weiteres Problem ist, dass die Datumswerte nicht sortiert sind und eine Sortierung bei der Datenmenge nicht zum nachholen ist.
Wenn eines der beiden Fälle eintritt soll die Zeile Rot markiert werden, damit ich diese fälle dann beim durchscrollen erkenne und die Fälle dann manuel prüfen kann.
Ich habe mal einen Auszug bzw. einen Beispielbereich eines Tabellenblattes erstellt und hochgeladen. Links und rechts von diesem Beispielsausschnitt sind noch andere Parameter bzw. Bezeichnungen vorhanden die aber meines erachtens nicht wichtig sind für das Vorhaben.
>>https://www.herber.de/bbs/user/54884.xls
Vielen Dank und viele Grüße

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub MehrfacheMarkieren() 'Markiert pro SUM-Bereich mehrfach vorkommendes Datum Dim wks As Worksheet Dim lngZeile As Long, lngZeile1 As Long, lngZeileSum As Long, lngI As Long Set wks = ActiveSheet With wks lngZeile1 = 2 For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row If .Cells(lngZeile, 1).Value = "SUMs" Then For lngI = lngZeile1 To lngZeile - 1 If Application.WorksheetFunction.CountIf(.Range(.Cells(lngZeile1, 1), _ .Cells(lngZeile - 1, 1)), .Cells(lngI, 1).Value) > 1 _ And .Cells(lngI, 1).Value "" Then .Cells(lngI, 1).Interior.ColorIndex = 3 'rot einfärben End If Next lngZeile1 = lngZeile + 1 End If Next End With End Sub

Sub MehrfacheMarkieren() 'Markiert pro SUM-Bereich mehrfach vorkommendes Datum Dim wks As Worksheet Dim lngZeile As Long, lngZeile1 As Long, lngZeileSum As Long, lngI As Long Set wks = ActiveSheet With wks lngZeile1 = 2 For lngZeile = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row If .Cells(lngZeile, 3).Value = "SUMs" Then For lngI = lngZeile1 To lngZeile - 1 If Application.WorksheetFunction.CountIf(.Range(.Cells(lngZeile1, 3), _ .Cells(lngZeile - 1, 3)), .Cells(lngI, 3).Value) > 1 _ And .Cells(lngI, 3).Value "" Then .Cells(lngI, 3).Interior.ColorIndex = 3 'rot einfärben End If Next lngZeile1 = lngZeile + 1 End If Next End With End Sub

Hallo nochmal,
nach dem ich mir jetzt ewig Gedanken gemacht habe um diesen Code zu verstehen habe ich den Fehler gefunden aber kann die Korrektur nicht alleine umsetzen.
Der Code setzt nun lngZeile1 = Zeilennummer in der ein SUMs gefunden wurde +1 und sucht weiter nach dem nächsten SUMs und prüft dann nach Wiederholungen, jedoch im zu großen Bereich.
Es kommt vor, dass zwischen dem letzten SUMs und dem aktuellen SUMs ein paar Datumsangaben sich befinden für die kein SUMs gebildet wurde und das Makro sagt dann LETZTES SUMs +1 BIS AKTUELLEM SUMs WIEDERHOLT SICH DAS DATUM ALSO ROT was aber falsch ist
Die einfachste Lösung wäre nach meinen Überlegungen, das man dem Makro sagt aktuelles SUMs nach oben geht bis zur ersten freien Zeile. Denn nach jedem SUMs gibt es mindestens 2 freie Zeilen.
Abier hier ist das Problem was passiert mit dem ersten SUMs welches dann oben die Spaltenüberschriften beinhaltet und keine leere Zelle in der Spalte hat?!?!?
Ich habe mal meine Gedanken in meiner Beispiel Tabelle veranschaulicht:
Die Farben sind gedanklich nur neben an um es zu veranschaulichen, es geht aber natürlich immer um Spalte 3 (C)
GRÜN = Prüfbereich nach dem bisherigen Makro natürlich in Spalte C (3)
ORANGE = Mein Vorschlag bis wohin der Suchbegriff sein sollte wiederum in Spalte C (3)
Nochmals vielen Dank für die Hilfe!
https://www.herber.de/bbs/user/54931.xls

Sub MehrfacheMarkieren() 'Markiert pro SUM-Bereich mehrfach vorkommendes Datum Dim wks As Worksheet, lngZaehler As Long Dim lngZeile As Long, lngZeile1 As Long, lngZeileSum As Long, lngI As Long Const SpalteSUMs As Long = 3 Set wks = ActiveSheet With wks For lngZeile = 2 To .Cells(.Rows.Count, SpalteSUMs).End(xlUp).Row If .Cells(lngZeile, SpalteSUMs).Value = "SUMs" Then 'Leerzeile oberhalb von SUMs ermitteln lngZeile1 = lngZeile Do lngZeile1 = lngZeile1 - 1 Loop Until IsEmpty(.Cells(lngZeile1, SpalteSUMs)) Or lngZeile1 = 2 'Mehrfach-Einträge markieren For lngI = lngZeile1 To lngZeile - 1 If Application.WorksheetFunction.CountIf(.Range(.Cells(lngZeile1, SpalteSUMs), _ .Cells(lngZeile - 1, SpalteSUMs)), .Cells(lngI, SpalteSUMs).Value) > 1 _ And .Cells(lngI, SpalteSUMs).Value "" Then .Cells(lngI, SpalteSUMs).Interior.ColorIndex = 3 'rot einfärben lngZaehler = lngZaehler + 1 End If Next End If Next End With MsgBox "Es wurden " & lngZaehler & " Mehrfacheinträge markiert." End Sub

Beliebteste Forumthreads (12 Monate)

Zeile rot färben bei 2 Bedinungen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread