Excel vba Farb-Formatierung

[sharky51]

Hallo zusammen,

leider hänge ich schon wieder an einem Problem bei dem Ihr mir hoffentlich weiterhelfen könnt.
Ich möchte eine Tabelle so formatieren dass alle gleichen Zelleinträge mit der gleichen Hintergrundfarbe belegt werden. Die nachfolgenden (anderen) gleichen Werte sollen dann in einer anderen Farbe gekennzeichnet werden. Solange die Anzahl der gleichen Werte größer als 1 ist funktioniert das auch. Kommt aber nur ein Wert vor wird dieser nicht berücksichtigt.

Hie mal ein super Beispiel aus dem Netz

Code:

'Doppelte / gleiche Werte in Excel-Spalte farblich markieren
'angelehnt an: http://www.ms-office-forum.net/forum/sitemap/index.php?t-277131.html
Sub Doppelte_markieren_Spalte_D()
 
  Dim lngZeile As Long
  Dim lngEnde As Long
  Dim strValue As String
  Dim objDupList As Object
  Dim arrFarben As Variant
  Dim intFarben As Integer
 
  arrFarben = Array(35, 36)   'Aufzählung der ColorIndex-Werte entsprechend anpassen
 
  Set objDupList = CreateObject("Scripting.Dictionary")    'Liste der Duplikate (Key) mit ColorIndex (Item)
 
  lngEnde = Cells(Rows.Count, LinkCol).End(xlUp).Row
 
  Columns("A:D").Interior.ColorIndex = xlNone 'Alle Farben in Spalte A:D zurücksetzen
 
  For lngZeile = 1 To lngEnde
     strValue = Cells(lngZeile, "D").Text
     If strValue <> "" Then      'Test Zelle nicht Leer
     If Application.CountIf(Range("D1:D" & lngEnde), strValue) > 1 Then
        If objDupList.Exists(strValue) Then
           Range(Cells(lngZeile, "A"), Cells(lngZeile, "D")).Interior.ColorIndex = objDupList.Item(strValue)
        Else
           Range(Cells(lngZeile, "A"), Cells(lngZeile, "D")).Interior.ColorIndex = arrFarben(intFarben)
           objDupList.Add strValue, arrFarben(intFarben)
           intFarben = intFarben + 1
           If intFarben > UBound(arrFarben) Then intFarben = 0
        End If
     End If
  End If
Next
End Sub

Wie müsste man den Code ändern dass die Zeile 392 und 393 wieder abwechselnd farblich markiert werden und entsprechen ab 394 wieder die Farbe wechselt?


Tabelle1

	D
389	D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\BackUp\
390	D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\BackUp\
391	D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\BackUp\
392	D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\Excel VBA\Aktienkurse einlesen\
393	D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\Excel VBA\CSV-Dateien einlesen\
394	D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\Excel VBA\Excel VBA allgemein\
395	D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\Excel VBA\Excel VBA allgemein\
396	D:\1_Mydaten_Aktiv\Office\Excel\Aktuell\Excel VBA\Excel VBA allgemein\

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 21.08 einschl. 64 Bit

Ich hoffe ich konnte das Problem einigermaßen gut beschreiben und freue mich auf einen Tipp wie das Makro geändert werden sollte.

[Flotter Feger]

Hallöchen,

du prüfst doch auch auf ...

If Application.CountIf(Range("D1:D" & lngEnde), strValue) > 1 Then

Dann werden natürlich nur Zeilen eingefärbt, die mehr als einmal vorkommen.

Lass die If-Zeile raus, oder prüfe auf > 0 ... macht natürlich keinen Sinn ... aber du siehst zumindest sofort ein Ergebnis ...

[sharky51]

Hallo Sabina,

herzlichen Dank, funktioniert super....und so einfach.
Logik ist manchmal so ne Sache wenn man den Wald vor lauter Bäumen nicht sieht.

Habe jetzt die IF-Zeile raus genommen.

Nochmals vielen Dank, auch an dieses tolle Forum!