makro um farben zu ersetzen

hans jupp · 04.09.2006

hallo,

ich brauche ein makro, daß mir abhängig vom zellinhalt die zellenfarbe verändert.
untersucht werden muß dabei der bereich c4:c8.

ich habe das mal versucht, als rein schematisches makro aufzubauen, damit ihr vielleicht besser versteht, was ich meine (leider haben mich dann meine vba-kenntnisse verlassen):

Sub inhalt_farben()

Const bereich = c4: c8

For Each zelle In bereich
If zelle = 1 Then .Interior.ColorIndex = 4
If zelle = 2 Then .Interior.ColorIndex = 3
If zelle = 3 Then .Interior.ColorIndex = 8
If zelle = 4 Then .Interior.ColorIndex = 6
If zelle = 5 Then .Interior.ColorIndex = 5
Next

vielen dank schonmal für eure hilfe

gruß,
kath.hundefriseursalon

End Sub

Matjes · 04.09.2006

Hallo kath.hundefriseursalon,

packe den folgenden Code in die Code-Seite des Tabellenblattes.
(Blattlasche mit rechter Maus anklicken-> Code anzeigen)

Gruß Matjes

Code:

Option Explicit

Private Sub Worksheet_Activate()
  Call ZellenEntsprechendWertEinfaerben(Range(C4:C8))
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range
  
  Set r = Intersect(Target, Range(C4:C8))
  If Not r Is Nothing Then
    Call ZellenEntsprechendWertEinfaerben(r)
  End If
  Set r = Nothing
End Sub


Private Function ZellenEntsprechendWertEinfaerben(Target As Range)
  Dim Zelle As Range
      
  For Each Zelle In Target
    With Zelle
      If .Value = 1 Then
        .Interior.ColorIndex = 4
      ElseIf .Value = 2 Then
        .Interior.ColorIndex = 3
      ElseIf .Value = 3 Then
        .Interior.ColorIndex = 8
      ElseIf .Value = 4 Then
        .Interior.ColorIndex = 6
      ElseIf .Value = 5 Then
        .Interior.ColorIndex = 5
      Else
        .Interior.ColorIndex = xlColorIndexNone
      End If
    End With
  Next
  Set Zelle = Nothing
End Function

hans jupp · 04.09.2006

hallo matjes,

das makro funktioniert prima!

vielen dank für deine schnelle hilfe!

gruß,
kath.hundefriseursalon

makro um farben zu ersetzen

hans jupp

Matjes

hans jupp

makro um farben zu ersetzen

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums