Thema: Zellenbereiche umfärben

Hallo

Gibt es eine Möglichkeit, die Hintergrundfarbe vordefinierter Zellen zu ändern?

In meine Makro wird die HIntergrundfarbe von Zellen mit bestimmten Inhalt eingestellt. Es funktioniert, aber es dauert ewig lange (einige Sekunden). Kann man das irgendwie beschleunigen? Vielleicht erst die Zellen mit bestimmten Inhalt sammeln und dann in einem umfärben, oder so was ähnliches?

Sub test()

    Dim rZelle As Range         'Laufvariable

    Dim rBereich As Range

    'Aufbau der Testumgebung

    Set rBereich = Range("b2").Resize(300, 5)

    rBereich.Clear

    rBereich = "www"

    rBereich(3, 1) = "kkk"

    rBereich(2, 2) = "eee"

        

    'Einfärben der Zellen gemäß Inhalt

    Application.ScreenUpdating = False

    For Each rZelle In rBereich

        If rZelle.Text = "www" Then

            rZelle.Interior.Color = vbYellow 

        ElseIf rZelle.Text = "kkk" Then

             rZelle.Interior.Color = vbCyan

        ElseIf rZelle.Text = "aaa" Then

             rZelle.Interior.Color = vbGreen

       End If

    Next rZelle

    Application.ScreenUpdating = True

End Sub

Freue mich auf Eure Ideen (mit Beispielcode).
Anmerkung: Das ist nur ein Beispielmakro. Hier soll die Lösung funktionieren. In Wirklichkeit habe ich zehn verschiedene Vergleichstexte mit Farben, abgelegt in einem Dictionary oder array, oder was auch immer.

LG, Flo

Mahlzeit!

Ich hab die Bereiche erst in einen zusammengelegt, dann gefärbt.
Im Zweiten beispielen habe ich aus den IF-Bedingungen noch select case gemacht. das macht es überschaubarer.

Schau mal , ob es so schneller geht.

Sub test()

    Dim rZelle As Range         'Laufvariable

    Dim rBereich As Range

    'Aufbau der Testumgebung

    Set rBereich = Range("b2").Resize(300, 5)

    rBereich.Clear

    rBereich = "www"

    rBereich(3, 1) = "kkk"

    rBereich(2, 2) = "eee"

    

    Dim Ber_yell As Range

    Dim Ber_cyan As Range

    Dim Ber_green As Range

    

    Set Ber_yell = Range("A1") 'ini-Bereich muss festgelegt sein

    Set Ber_cyan = Range("A1")

    Set Ber_green = Range("A1")

        

    'Einfärben der Zellen gemäß Inhalt

    Application.ScreenUpdating = False

    For Each rZelle In rBereich

        If rZelle.Text = "www" Then

            Set Ber_yell = Application.Union(rZelle, Ber_yell)

        ElseIf rZelle.Text = "kkk" Then

            Set Ber_cyan = Application.Union(rZelle, Ber_cyan)

        ElseIf rZelle.Text = "aaa" Then

            Set Ber_green = Application.Union(rZelle, Ber_green)

       End If

    Next rZelle

    

    Ber_yell.Interior.Color = vbYellow

    Ber_cyan.Interior.Color = vbCyan

    Ber_green.Interior.Color = vbGreen

    

    Range("A1").Interior.ColorIndex = xlNone

        

    Application.ScreenUpdating = True

End Sub

Sub test2()

    Dim rZelle As Range         'Laufvariable

    Dim rBereich As Range

    'Aufbau der Testumgebung

    Set rBereich = Range("b2").Resize(300, 5)

    rBereich.Clear

    rBereich = "www"

    rBereich(3, 1) = "kkk"

    rBereich(2, 2) = "eee"

    

    Dim Ber_yell As Range

    Dim Ber_cyan As Range

    Dim Ber_green As Range

    

    Set Ber_yell = Range("A1") 'ini-Bereich muss festgelegt sein

    Set Ber_cyan = Range("A1")

    Set Ber_green = Range("A1")

        

    'Einfärben der Zellen gemäß Inhalt

    Application.ScreenUpdating = False

    For Each rZelle In rBereich

        Select Case rZelle.Text

            Case Is = "www": Set Ber_yell = Application.Union(rZelle, Ber_yell)

            Case Is = "kkk": Set Ber_cyan = Application.Union(rZelle, Ber_cyan)

            Case Is = "aaa": Set Ber_green = Application.Union(rZelle, Ber_green)

       End Select

    Next rZelle

    

    Ber_yell.Interior.Color = vbYellow

    Ber_cyan.Interior.Color = vbCyan

    Ber_green.Interior.Color = vbGreen

    

    Range("A1").Interior.ColorIndex = xlNone

        

    Application.ScreenUpdating = True

End Sub

Gruß, MCO

Hallo MCO,

funktioniert bestens.

Ich kann sogar Blöcke relativ daneben auch noch einfärben (mein Geheimwunsch):
Ber_yell.Interior.Color = vbYellow
Ber_yell.Offset(, 5).Interior.Color = vbYellow

Vielen Dank,
Flo