Zellfarbe mit Makro ändern.

[joyy]

Hallo,

kann mir jemand mit einen Makro helfen? Ich benutze Excel 2010 / Windows 7.

Problembeschreibung:
In einer Tabelle sind einige Zellen unterschiedlich farbig ausgefüllt. Je Spalte soll die Farbe bestimmter farbiger Zellen in eine andere Farbe verändert werden. Es sind je Spalte 2 Farben zu verändern.
Das Makro sollte folgendermaßen aufgebaut sein. Wenn in Spalte C, Bereich 4:5000 die Zellfarbe einer oder mehrerer beliebiger Zellen gleich der Zellfarbe in Zelle G2 ist dann die Zellfarbe wie in Zelle D2 ändern und wenn in Spalte C, Bereich 4:5000 die Zellfarbe einer oder mehrerer beliebiger Zellen gleich der Zellfarbe in Zelle E2 ist dann die Zellfarbe wie in Zelle F2 ändern.
Dieses Makro werde ich dann ändern wenn ich in einer anderen Spalte die Farben wechseln muss. In einer Spalte sind unterschiedlich viele Zellen mit den zu verändernden Farben ausgefüllt.
Text und Kommentar sind auch in den Zellen enthalten. Hier ist keine Veränderung durch den Farbwechsel gewünscht.

Bin auf Lösungen gespannt.
Thorsten

[RPP63]

Hallo Thorsten!
Mal ein Ansatz, musst Du auf Deine Belange anpassen (hab keine Lust, Deine Tabelle nachzubauen):
Alte Farbe in G2, neue in D2, geändert wird in Spalte A:

Code:

Sub NeueFarbeInSpalteA()
Dim AlteFarbe As Double, NeueFarbe As Double
Dim Zelle As Range
With Tabelle1
   AlteFarbe = .Cells(2, 7).Interior.Color
   NeueFarbe = .Cells(2, 4).Interior.Color
   For Each Zelle In Intersect(.Columns(1), .UsedRange)
      If Zelle.Interior.Color = AlteFarbe Then Zelle.Interior.Color = NeueFarbe
   Next
End With
End Sub

Gruß Ralf

[joyy]

Hallo Ralf,

Danke für den Lösungsansatz. Mit deinem Ansatz komme ich weiter. Wenn man nicht in der ganzen Spalte sondern erst ab Zeile 4 die Farbe wechseln könnte ist es für mich perfekt. Gefragt war ab Zeile 4 bis Zeile 5000.

Gruß
Thorsten

[RPP63]

Hi Thorsten!
Dann tausche doch einfach

Code:

Intersect(.Columns(1), .UsedRange)

mit

Code:

.Range("C4:C5000")

oder besser (um unnötige Schleifendurchläufe zu vermeiden)

Code:

Intersect(.Range("C4:C5000"), .UsedRange)

Gruß Ralf

[joyy]

Hallo Ralf,

für mich ist das nicht so einfach, da ich mit Makros so gut wie keine Erfahrung habe.
Die Range habe ich jetzt geändert und es funktioniert super. Leider war ich zu euphorisch bei meiner ersten Antwort, das es perfekt ist wenn es mit der Range funktioniert. ich hatte ganz ausgeblendet, dass ja zwei unterschiedliche Farben gegen 2 andere Farben in der Spalte zu tauschen sind.
Wenn du dafür auch noch eine Lösung hast ist das Problem gelöst.

Gruß
Thorsten

[joyy]

Hallo Ralf,

ich habe den code mal folgendermaßen abgeändert.


Sub NeueFarbeInSpalteA()
Dim AlteFarbe As Double, NeueFarbe As Double
Dim Zelle As Range
With Tabelle1
AlteFarbe = .Cells(2, 4).Interior.Color
NeueFarbe = .Cells(2, 5).Interior.Color
For Each Zelle In Intersect(.Range("O4:O5000"), .UsedRange)
If Zelle.Interior.Color = AlteFarbe Then Zelle.Interior.Color = NeueFarbe
Next
With Tabelle1
AlteFarbe = .Cells(2, 6).Interior.Color
NeueFarbe = .Cells(2, 7).Interior.Color
For Each Zelle In Intersect(.Range("O4:O5000"), .UsedRange)
If Zelle.Interior.Color = AlteFarbe Then Zelle.Interior.Color = NeueFarbe
Next
End With
End With
End Sub


Ist das so eine effektive Umsetzung? Es funktioniert auf jeden Fall und danke für deine Hilfe.

Gruß
Thorsten

[RPP63]

Hallo Thorsten!
Siehst Du, das bezeichne ich als Hilfe zur Selbsthilfe! :23:
Auch wenn man Stellschrauben drehen könnte:
Entscheidend ist, dass Du das Prinzip verstanden hast und auf Deine Belange umsetzen konntest! :18:

(Demnächst hilfst Du mir bei meinen Excel-Problemen ...)

*ThumbsUp*
Ralf