Zellen Farben zuweisen über VBA

[cavok]

Hallo Forum,

ich bräuchte mal kurz Eure Hilfe.

ich habe ein arbeitsblatt und möchte in zwei Spalten jeweils den einzelnen Zellen bei bestimmten Einträgen eine Farbe zuweisen.
Da es sich um mehr als 7 verschiedene Farben handelt habe ich es in VBA versucht.

Das Ergebnis es funktioniert nur eine Farbe.
Da ich in VBA nicht so firm bin, habe ich einen Fehler gemacht.
Mein Code sieht folgendermaßen aus.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 14 Or Target.Column = 15 Then

If Target.Value = 1 Then
    Target.Interior.ColorIndex = 3
If Target.Value = 2 Then
    Target.Interior.ColorIndex = 16
If Target.Value = 3 Then
    Target.Interior.ColorIndex = 6
If Target.Value = 4 Then
    Target.Interior.ColorIndex = 5
If Target.Value = 5 Then
    Target.Interior.ColorIndex = 4
If Target.Value = 6 Then
    Target.Interior.ColorIndex = 46
If Target.Value = 7 Then
    Target.Interior.ColorIndex = 7
   
Else
Target.Value = ""
End If
   End If
       End If
           End If
               End If
                   End If
                       End If
                           End If
                           
   
End Sub

Kann mir jemand weiterhelfen.

Im Voraus vielen Dank

Gruß
Hubert

[Fennek]

Hallo,

versuche jede if-Abfrage direkt abzuschließen, also z.B.

Code:

If Target.Value = 1 Then
   Target.Interior.ColorIndex = 3
end if

mfg

[cavok]

Hallo Fennek,

Bingo jetzt funktioniert es  :19:  :19:  

Vielen Dank und und einen schönen Tag


Gruß
Hubert

[chris-ka]

Hi,

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 14 Or Target.Column = 15 Then
    For Each Target In Target
        Target.Interior.ColorIndex = Choose(Target.Value, 3, 16, 6, 5, 4, 46, 7)
    Next
End If
End Sub

geht ein wenig kürzer....:)

[cavok]

Hallo Chris,

nochmals Danke für Deine verkürzte Version des Codes.

Ich habe die verkürzte Version angewandt und auf andere Spalten übertragen. Das wird jedoch nicht akzeptiert.
Ich bekomme eine Fehlermeldung.

Woran kann das liegen?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 3 Then       'Funktioniert nicht'
   For Each Target In Target
       Target.Interior.ColorIndex = Choose(Target.Value, 43)
   Next
   End If


If Target.Column = 5 Then                  'Funktioniert nicht'
   For Each Target In Target
       Target.Interior.ColorIndex = Choose(Target.Value, 38)
   Next
   End If


If Target.Column = 7 Then                    'Funktioniert nicht'
   For Each Target In Target
       Target.Interior.ColorIndex = Choose(Target.Value, 44)
   Next
End If
   
       
If Target.Column = 14 Or Target.Column = 15 Then    'funktioniert'
   For Each Target In Target
       Target.Interior.ColorIndex = Choose(Target.Value, 3, 16, 6, 5, 4, 46, 7)
   Next
End If
End Sub

Gruß
Hubert

[cavok]

Hallo,

Zu früh gepostet. :16:

das ist natürlich Nonsens.
Ich habe die Spalten integriert. die Farben existieren ja schon.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
        
If Target.Column = 3 Or Target.Column = 5 Or Target.Column = 7 Or Target.Column = 14 Or Target.Column = 15 Then
    For Each Target In Target
        Target.Interior.ColorIndex = Choose(Target.Value, 3, 16, 6, 5, 4, 46, 7)
    Next
End If
End Sub

Einen schönen Feiertag

Gruß
Hubert