MS Excel, VBA: Zellen unterschiedlich färben

Hallo!

Ich suche nach einer Möglichkeit über VBA in Excel eine Art ‚Mustererkennung‘ zu bauen.

Als input dient ein ein Excel-Sheet (:wink:) in welchem in Zeilenweise in jeder Zelle Buchstaben-Zahlen-Kombinationen stehen, zB:

A B C D …
1 xy b1 z6 b2
2 ws e4 5t g5
2 4r 6z h7 8u

Je nach Kombination der einzelnen Zellen innerhlab einer Zeile sollte nun eine bestimmte Hintergrundfarbe sichtbar sein, zB:

A B C D …
1 rot rot z6 b2
2 ws e4 blau g5
2 gelb gelb gelb 8u

Problem 1:
Mehrere Zellen bilden 1 Muster, deswegen kann ich nicht sagen: wenn xy–>rot. wenn b1–>rot. Sondern eher: wenn xy und nächste zelle b1 --> beide rot.

Problem 2:
Bin in Sachen VBA völlig neu, daher wäre eine ausführliche Erklärung sehr hilfreich.

Bedingte Formatierung ist zu wenig und einzelne Zellen färben ist nach ein bisschen Recherche nicht sonderlich schwer, reicht aber wie ihr seht nicht aus.

Hoffentlich wurd mein Anliegen klar.

-mh

A B C D …
1 xy b1 z6 b2
2 ws e4 5t g5
2 4r 6z h7 8u
Je nach Kombination der einzelnen Zellen innerhlab einer Zeile
sollte nun eine bestimmte Hintergrundfarbe sichtbar sein, zB:
A B C D …
1 rot rot z6 b2
2 ws e4 blau g5
2 gelb gelb gelb 8u
wenn b1–>rot. Sondern eher: wenn xy und
nächste zelle b1 --> beide rot.

Hallo Mh,

Alt+F11, Einfügen–Modul, Code reinkopieren, Editor schliessen, Alt+F8, Makro ausführen.

Sub Musterfarbe()
Dim Zei As Long, Spa As Long
For Zei = 1 To Cells(Rows.Count, 1).End(xlUp).Row
 For Spa = Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
 If Cells(Zei, Spa) = "b1" And Cells(Zei, Spa).Offset(0, -1) = "xy" Then
 Cells(Zei, Spa).Interior.ColorIndex = 3
 Cells(Zei, Spa).Offset(0, -1).Interior.ColorIndex = 3
 End If
 Next Spa
Next Zei
End Sub

Gruß
Reinhard

Guten Tag,

Wow, das ging aber schnell. Klappt wunderbar! Vielen Dank Reinhard!

-mh

Klappt wunderbar! Vielen Dank

Hallo mh,

dankeschön.
Was mich erstaunt, du hast ja in deinem Beispiel noch andere „Muster“ die dann wohl blaue bzw. gelbe Zellen färben sollen.

Da du selbst sagst daß du erst kurz davor stehst Excelvollprofi zu sein *lächel* bin ich erstaunt daß keine Nachfragen zu den anderen Mustern kommen.

Okay, ich stehe kürzer davor *gg*, deshalb fiel mir sofort gleich nach dem Abschicken des Codes auf daß da etwas Wichtiges fehlt.
Und zwar die Frabwegnahme wenn durch Zellinhaltsänderung das Muster nicht mehr vorliegt.

Aber da ich mir dachte du fragst wegen den anderen Mustern eh nach, hab ich mir gedacht ich bau das ein wenn der Gesamtcode besteht.

Aber bitteschön, wenn du mit dem Code gut klar kommst…

Gruß
Reinhard

Hallo Reinhard,

bin schon länger ‚Softwerker‘, von daher bin ich einiges gewohnt. :wink:

Einzige Verbesserung+mehrere Muster:

Sub Musterfarbe()
Dim Zei As Long, Spa As Long
For Zei = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For Spa = Cells( Zei , Columns.Count).End(xlToLeft).Column To 2 Step -1
If Cells(Zei, Spa) = „b1“ And Cells(Zei, Spa).Offset(0, -1) = „xy“ Then
Cells(Zei, Spa).Interior.ColorIndex = 3
Cells(Zei, Spa).Offset(0, -1).Interior.ColorIndex = 3
End If
Next Spa
For Spa = Cells( Zei , Columns.Count).End(xlToLeft).Column To 2 Step -1
If Cells(Zei, Spa) = „b4“ And Cells(Zei, Spa).Offset(0, -1) = „b5“ Then
Cells(Zei, Spa).Interior.ColorIndex = 5
Cells(Zei, Spa).Offset(0, -1).Interior.ColorIndex = 5
End If
Next Spa
For Spa = Cells( Zei , Columns.Count).End(xlToLeft).Column To 2 Step -1
If Cells(Zei, Spa) = „aa“ Then
Cells(Zei, Spa).Interior.ColorIndex = 4
End If
Next Spa
Next Zei
End Sub

Hab 's schon über eine Tabelle mit >2.5k Zeilen und wechslender Spaltenanzahl (deswegen die ‚Verbesserung‘) laufen lassen. Funzt!

-mh

Hallo mh,

bin schon länger ‚Softwerker‘, von daher bin ich einiges
gewohnt. :wink:

aha.
Aber nobody is perfect. Mein Code war ausgelegt für zweispaltige Muster.
Erkennst du den Fehler in:

For Spa = Cells(Zei, Columns.Count).End(xlToLeft).Column To 2 Step -1
 If Cells(Zei, Spa) = "aa" Then
 Cells(Zei, Spa).Interior.ColorIndex = 4
 End If
Next Spa

Gruß
Reinhard

Erkennst du den Fehler in:

For Spa = Cells(Zei, Columns.Count).End(xlToLeft).Column To **1**
Step -1
 If Cells(Zei, Spa) = "aa" Then
 Cells(Zei, Spa).Interior.ColorIndex = 4
 End If


> Next Spa

Gruß
Reinhard

ctrl+c,ctrl+v. Kann schon mal passiern :smile:

-mh