Doppelungen per Zeile markieren - Excel VBA

Hallo liebe Excel-Pro´s,

in angefügtem Excel befinden sich in Spalte I-M Arbeitspakete, welche von unterschiedlichen Leuten (Zellwerte sind die Initialen der Personen) bearbeitet werden.
https://www.herber.de/bbs/user/164499.xlsm

Damit keiner 2 Arbeitspakete an einem Tag bekommt, soll markiert werden, wenn eine Person 2 Pakete an einem Tag hat (z. B. hat PG am 2.1.2024 Packet 1 und 3, was nicht sein sollte). Außerdem sollten die die Personen markiert werden, wenn die Person ein Packet bekommen hat, aber an dem Tag im Urlaub oder Gleittag hat (Spalte C-G, Uraub ist U, Gleittag ist G; zum Beispiel hat AV am 3.1. Gleittag, müsste aber trotzdem in Packet 2 mitarbeiten).

Ich hab es auf zwei Methoden versucht (siehe Quellcode), scheitere aber daran, dass er bei CountIf meckert...

Könnt Ihr helfen? :-)

Vielen Dank und viele Grüße
Andi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hier hab ich nochmals meinen Quellcode (Versuch 1 und 2), bin mir nicht sicher, ob das im Anhang ersichtlich ist:

Sub DoppelteWerteMarkieren()

Dim lngZeile As Long
Dim lngSpalte As Long
Dim lngZeileMax As Long
Dim lngSpalteMax As Long
Dim lngZeileMin As Long
Dim lngSpalteMin As Long
Dim Bereich As Range

With Tabelle1 'mit Tabelle 1

lngZeileMax = .UsedRange.Rows.Count 'liest letzte benutzte Spalte in Variable ZeileMax ein
lngSpalteMax = .UsedRange.Columns.Count 'liest letzte benutzte Spalte in Variable SpalteMax ein
lngZeileMin = 7
lngSpalteMin = 9

For lngSpalte = lngSpalteMin To lngSpalteMax 'Beginn Spaltenloop (von Spalte 9 zu letzer benutzter Zeile)
For lngZeile = lngZeileMin To lngZeileMax 'Beginn Zeilenloop (von Zeile 7 zu letzter Zeile

Set Bereich = Range(Cells(lngZeile, lngSpalteMin), Cells(lngZeile, lngSpalteMax))

If .Application.WorksheetFunction.CountIf(Bereich).Value > 1 Then
.Bereich.Interior.ColorIndex = 4
Else
.Bereich.Interior.colorindes = xlColorIndexNone
End If

Next lngZeile 'nächster Zeilenloop
Next lngSpalte 'nächster Spaltenloop

End With 'End With

End Sub

Sub DoppelteWerteMarkierenVersuch2()

Dim lngZeile As Long
Dim lngSpalte As Long
Dim lngZeileMax As Long
Dim lngSpalteMax As Long
Dim lngZeileMin As Long
Dim lngSpalteMin As Long
Dim Bereich As Range

With Tabelle1 'mit Tabelle 1

lngZeileMax = .UsedRange.Rows.Count 'liest letzte benutzte Spalte in Variable ZeileMax ein
lngSpalteMax = .UsedRange.Columns.Count 'liest letzte benutzte Spalte in Variable SpalteMax ein
lngZeileMin = 7
lngSpalteMin = 9

For lngZeile = lngZeileMin To lngZeileMax

Set Bereich = Range(Cells(lngZeile, lngSpalteMin), Cells(lngZeile, lngSpalteMax))
With .Range(Bereich)
.FormatConditions.Delete
.FormatConditions.AddUniqueValues
.FormatConditions(1).DupeUnique = xlDublicate
.formatcontions(1).Interior.Color = vbYellow
End With

Next lngZeile

End With

End Sub

Sub DoppelteWerteMarkieren() Dim lngZeile As Long Dim lngSpalte As Long Dim lngZeileMax As Long Dim lngSpalteMax As Long Dim lngZeileMin As Long Dim lngSpalteMin As Long Dim Bereich As Range Dim a As Variant With Tabelle1 'mit Tabelle 1 lngZeileMax = .UsedRange.Rows.Count 'liest letzte benutzte Spalte in Variable ZeileMax ein lngSpalteMax = .UsedRange.Columns.Count 'liest letzte benutzte Spalte in Variable SpalteMax ein lngZeileMin = 7 lngSpalteMin = 9 For lngSpalte = lngSpalteMin To lngSpalteMax 'Beginn Spaltenloop (von Spalte 9 zu letzer benutzter Zeile) For lngZeile = lngZeileMin To lngZeileMax 'Beginn Zeilenloop (von Zeile 7 zu letzter Zeile Set Bereich = .Range(.Cells(lngZeile, lngSpalteMin), .Cells(lngZeile, lngSpalteMax)) If Application.WorksheetFunction.CountIf(Bereich, Cells(lngZeile, lngSpalte)) > 1 Then .Cells(lngZeile, lngSpalte).Interior.ColorIndex = 4 Else .Cells(lngZeile, lngSpalte).Interior.ColorIndex = xlColorIndexNone End If '-----wenn in Abwesend etwas steht----- a = Application.Match(.Cells(lngZeile, lngSpalte), Range("C6:G6"), 0) If IsNumeric(a) Then If .Cells(lngZeile, a + 2) > "" Then .Cells(lngZeile, lngSpalte).Interior.ColorIndex = 3 End If '-------------------------------------- Next lngZeile 'nächster Zeilenloop Next lngSpalte 'nächster Spaltenloop End With 'End With End Sub

Sub DoppelteWerteMarkieren2() Dim lngZeile As Long Dim lngSpalte As Long Dim lngZeileMax As Long Dim lngSpalteMax As Long Dim lngZeileMin As Long Dim lngSpalteMin As Long Dim Bereich As Range With Sheets("Tabelle1") lngZeileMax = .UsedRange.Rows.Count 'liest letzte benutzte Spalte in Variable ZeileMax ein lngSpalteMax = .UsedRange.Columns.Count 'liest letzte benutzte Spalte in Variable SpalteMax ein lngZeileMin = 7 lngSpalteMin = 9 For lngZeile = lngZeileMin To lngZeileMax Set Bereich = Range(Cells(lngZeile, lngSpalteMin), Cells(lngZeile, lngSpalteMax)) With Bereich .FormatConditions.Delete .FormatConditions.AddUniqueValues .FormatConditions(1).DupeUnique = xlDuplicate .FormatConditions(1).Interior.Color = vbYellow End With Next lngZeile End With End Sub

Beliebteste Forumthreads (12 Monate)

Doppelungen per Zeile markieren - Excel VBA

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread