Bedingte Formatierung mit VBA

[stonemaus]

Guten Morgen

Ich habe ein Problem mit Range offset und hoffe auf Eure Hilfe
Die Formatierung mit VBA habe ich mit diesem Script versucht leider ist meine Lösung nicht vollständig.
[
Bild bitte so als Datei hochladen: Klick mich!
] das Problem, es sollten die linken verbundenen und die rechten 3 Zellen eingefärbt sein.
Leider sieht es wie oben aus.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim RaBereich As Range                  ' Variable für Bereich
   Dim RaZelle As Range                    ' Variable für Zelle
   Set RaBereich = Range("A6:C50")        ' Bereich der Wirksamkeit
   Set RaBereich = Intersect(RaBereich, Target)
   If Not RaBereich Is Nothing Then
       For Each RaZelle In RaBereich
           With Range(RaZelle.Address, RaZelle.Offset(0, 1).Address)
               Select Case UCase(RaZelle.Value) ' Umwandlung der Eingabe in Großbuchstaben
                   Case "A"
                       .Interior.Color = 255       ' Füllfarbe Rot
                       .Font.ColorIndex = xlAutomatic
                       .NumberFormat = "General"   ' Zellenformat Standard
                   Case "B"
                       .Interior.Color = 65535     ' Füllfarbe Gelb
                       .Font.ColorIndex = xlAutomatic
                       .NumberFormat = "General"
                   Case Else
                       .Interior.ColorIndex = xlNone
                       .Font.ColorIndex = xlAutomatic
                       .NumberFormat = "General"
               End Select
           End With
       Next RaZelle
   End If
   Set RaBereich = Nothing                         ' Variable leeren
End Sub

Danke schon mal im Voraus

MfG Peter

[RPP63]

Moin!
Zeig mal eine Datei zum spielen!
(Mein rechter Zeigefinger bekommt nämlich immer Krämpfe, wenn er sich, auf der linken Maustaste befindend, der Schaltfläche "Verbinden und Zentrieren" nähert)
Will heißen, so etwas nutze ich nur in einem auszudruckenden Formular, niemals in einer Produktiv-Liste.

Prinzipiell müsste aber der Offset(0, 1) korrekt sein.
Warum willst Du dies mittels VBA machen?

Gruß Ralf

[RPP63]

Hab noch einmal die Eingangsfrage genauer gelesen.
Du möchtest ja ALLE Zellen neben dem Zellverbund färben.

Besteht dieser immer aus drei Zeilen?
Dann nimm .Offset(0, 1).Resize(3, 1)

Sind es unterschiedliche "Höhen"?
Dann musst Du die MergeArea auswerten und die Zeilen im Resize angeben.

Gruß Ralf

[RPP63]

Und noch etwas:
Um einen Range zu übergeben, ist der Umweg über .Address flüssiger als Wasser …

[Kuwer]

Hallo Peter,

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim RaBereich As Range                  ' Variable für Bereich 

  Set RaBereich = Intersect(Range("A6:C50"), Target)    ' Bereich der Wirksamkeit 

  If Not RaBereich Is Nothing Then

      With RaBereich.EntireRow.Cells(1).MergeArea.Resize(, 3)

         Select Case UCase(.Cells(1).Value) ' Umwandlung der Eingabe in Großbuchstaben 

             Case "A"

                 .Interior.Color = 255       ' Füllfarbe Rot 

                 .Font.ColorIndex = xlAutomatic

                 .NumberFormat = "General"   ' Zellenformat Standard 

             Case "B"

                 .Interior.Color = 65535     ' Füllfarbe Gelb 

                 .Font.ColorIndex = xlAutomatic

                 .NumberFormat = "General"

             Case Else

                 .Interior.ColorIndex = xlNone

                 .Font.ColorIndex = xlAutomatic

                 .NumberFormat = "General"

         End Select

     End With

  End If

  Set RaBereich = Nothing                         ' Variable leeren 

End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Gruß Uwe

[stonemaus]

Hallo und vielen herzlichen Dank an alle !

Hat super funktioniert.

MfG Peter