Zeile aufgrund Werte einfärben | Herbers Excel-Forum

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Zeile aufgrund Werte einfärben | Herbers Excel-Forum

Zeile aufgrund Werte einfärben von Ben vom 07.01.2010 09:39:59

AW: Zeile aufgrund Werte einfärben - von Josef Ehrensberger am 07.01.2010 09:49:24
AW: Zeile aufgrund Werte einfärben - von Hajo_Zi am 07.01.2010 09:50:03
AW: Zeile aufgrund Werte einfärben - von Tino am 07.01.2010 09:50:57
- Korrektur Eingabebereich und Bereich färben - von Tino am 07.01.2010 10:20:29
  - AW: Korrektur Eingabebereich und Bereich färben - von Ben am 07.01.2010 10:26:42
  - eine If vergessen (nicht ausgeschlafen) - von Tino am 07.01.2010 10:27:22
    - AW: eine If vergessen (nicht ausgeschlafen) - von Ben am 07.01.2010 10:57:50
      - demnach müsste es so funktionieren. - von Tino am 07.01.2010 11:28:07
        
        AW: demnach müsste es so funktionieren. - von Ben am 07.01.2010 11:40:23

Betrifft: Zeile aufgrund Werte einfärben von: Ben
Geschrieben am: 07.01.2010 09:39:59

Hallo Forum
Ich habe folgenden Code, um eine Zeile abhängig vom Wert in Spalte R, einzufärben:

Sub Zellenfarbe()
Dim rngZelle As Range, strText As String
ActiveSheet.Range("C6:D100").Interior.ColorIndex = 0
For Each rngZelle In ActiveSheet.Range("R1:R100")
Select Case rngZelle.Value
Case "a"
Range("C" & rngZelle.Row & ":D" & rngZelle.Row).Interior.ColorIndex = 2
Case "b"
Range("C" & rngZelle.Row & ":D" & rngZelle.Row).Interior.ColorIndex = 3
Case "c"
Range("C" & rngZelle.Row & ":P" & rngZelle.Row).Interior.ColorIndex = 37
Case "d"
Range("C" & rngZelle.Row & ":D" & rngZelle.Row).Interior.ColorIndex = 35
Case "e"
Range("C" & rngZelle.Row & ":P" & rngZelle.Row).Interior.ColorIndex = 6
Case "f"
Range("C" & rngZelle.Row & ":P" & rngZelle.Row).Interior.ColorIndex = 15

End Select
Next
End Sub

Das funktioniert, wenn ich das Makro manuell laufen lasse. Wie muss ich den Code anpassen, wenn das Färben gleich bei Veränderung des Wertes in Spalte R erfolgen soll? Irgendwie krieg ich das nicht richtig hin.

Vielen Dank und Gruss
Ben

Betrifft: AW: Zeile aufgrund Werte einfärben von: Josef Ehrensberger
Geschrieben am: 07.01.2010 09:49:24

Hallo Ben,

in das Modul der Tabelle.

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngZelle As Range, lngColor As Long

  If Not Intersect(Target, Range("C6:D100")) Is Nothing Then
    For Each rngZelle In Intersect(Target, Range("C6:D100"))
      Select Case rngZelle.Value
        Case "a": lngColor = 2
        Case "b": lngColor = 3
        Case "c": lngColor = 37
        Case "d": lngColor = 35
        Case "e": lngColor = 6
        Case "f": lngColor = 15
        Case Else: lngColor = xlNone
      End Select
      Range("C" & rngZelle.Row & ":P" & rngZelle.Row).Interior.ColorIndex = lngColor
    Next
  End If

End Sub

Gruß Sepp

Betrifft: AW: Zeile aufgrund Werte einfärben von: Hajo_Zi
Geschrieben am: 07.01.2010 09:50:03

Hallo Ben,

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.Range("C6:D100").Interior.ColorIndex = 0
    Dim RaBereich As Range, RaZelle As Range
    ' Bereich der Wirksamkeit
    Set RaBereich = Range("R1:R100")
    Set RaBereich = Intersect(RaBereich, Range(Target.Address))
    If Not RaBereich Is Nothing Then
        'ActiveSheet.Unprotect ("Passwort")
        For Each RaZelle In RaBereich
        Select Case RaZelle.Value
            Case "a"
                Range("C" & RaZelle.Row & ":D" & RaZelle.Row).Interior.ColorIndex = 2
            Case "b"
                Range("C" & RaZelle.Row & ":D" & RaZelle.Row).Interior.ColorIndex = 3
            Case "c"
                Range("C" & RaZelle.Row & ":P" & RaZelle.Row).Interior.ColorIndex = 37
            Case "d"
                Range("C" & RaZelle.Row & ":D" & RaZelle.Row).Interior.ColorIndex = 35
            Case "e"
                Range("C" & RaZelle.Row & ":P" & RaZelle.Row).Interior.ColorIndex = 6
            Case "f"
                Range("C" & RaZelle.Row & ":P" & RaZelle.Row).Interior.ColorIndex = 15
        End Select
        Next RaZelle
        'ActiveSheet.protect ("Passwort")
    End If
    Set RaBereich = Nothing
End Sub

Unter der Tabelle.

Grußformel

Betrifft: AW: Zeile aufgrund Werte einfärben von: Tino
Geschrieben am: 07.01.2010 09:50:57

Hallo,
versuche es mal so.

kommt als Code in Tabelle

Option Explicit  Private Sub Worksheet_Change(ByVal Target As Range) Dim rngZelle As Range, tmpZelle As Range  Set rngZelle = Intersect(Range("C6:D100"), Target)  For Each rngZelle In rngZelle     Set tmpZelle = Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4))     Select Case rngZelle.Value         Case "a": tmpZelle.Interior.ColorIndex = 2         Case "b": tmpZelle.Interior.ColorIndex = 3         Case "c": tmpZelle.Interior.ColorIndex = 37         Case "d": tmpZelle.Interior.ColorIndex = 35         Case "e": tmpZelle.Interior.ColorIndex = 6         Case "f": tmpZelle.Interior.ColorIndex = 15         Case Else: tmpZelle.Interior.ColorIndex = 0     End Select Next  End Sub

Gruß Tino

Betrifft: Korrektur Eingabebereich und Bereich färben von: Tino
Geschrieben am: 07.01.2010 10:20:29

Hallo,
habe Deinen Code nicht richtig gelesen.
Die Eingabe erfolgt ja in Spalte R und bei a, b u. d wird nur von Spalte C bis D gefärbt und
die anderen bis Spalte P

Private Sub Worksheet_Change(ByVal Target As Range)Dim rngZelle As RangeSet rngZelle = Intersect(Range("R6:R100"), Target)For Each rngZelle In rngZelle        Select Case rngZelle.Value        Case "a"            Range(Cells(rngZelle.Row, 5), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0            Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4)).Interior.ColorIndex = 2        Case "b"            Range(Cells(rngZelle.Row, 5), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0            Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4)).Interior.ColorIndex = 3        Case "c"            Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 37        Case "d"            Range(Cells(rngZelle.Row, 5), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0            Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4)).Interior.ColorIndex = 35        Case "e"            Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 6        Case "f"            Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 15        Case Else            Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0    End SelectNextEnd Sub

Gruß Tino

Betrifft: AW: Korrektur Eingabebereich und Bereich färben von: Ben
Geschrieben am: 07.01.2010 10:26:42

Hi Tino
Danke schonmal.
Habe Deinen korrigierten Code soeben getestet. Ich erhalte die Fehlermeldung

Laufzeitfehler 424. Objekt erforderlich.

Nachdem ich auf "Debuggen" geklickt habe springt er auf

For Each rngZelle In rngZelle

Ansonsten hast Du den Sachverhalt bzgl. Eingabe und Einfärbung genau richtig eingeschätzt.

Gruss
Ben

Betrifft: eine If vergessen (nicht ausgeschlafen) von: Tino
Geschrieben am: 07.01.2010 10:27:22

Hallo,
so jetzt sollte es gehen.

Private Sub Worksheet_Change(ByVal Target As Range)Dim rngZelle As RangeSet rngZelle = Intersect(Range("R6:R100"), Target)If Not rngZelle Is Nothing Then    For Each rngZelle In rngZelle                Select Case rngZelle.Value            Case "a"                Range(Cells(rngZelle.Row, 5), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4)).Interior.ColorIndex = 2            Case "b"                Range(Cells(rngZelle.Row, 5), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4)).Interior.ColorIndex = 3            Case "c"                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 37            Case "d"                Range(Cells(rngZelle.Row, 5), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4)).Interior.ColorIndex = 35            Case "e"                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 6            Case "f"                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 15            Case Else                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0        End Select    NextEnd IfEnd Sub

Gruß Tino

Betrifft: AW: eine If vergessen (nicht ausgeschlafen) von: Ben
Geschrieben am: 07.01.2010 10:57:50

Hi
Ich habe mich wohl etwas unklar ausgedrückt. Die eigentliche Eingabe erfolgt nicht in Spalte R sondern in Spalte D. In Spalte R wird - je nach Eingabe in Spalte D - a, b, c, d oder e als Resultat ausgegeben. Brauchts dazu nochmals eine Anpassung?
Ansonsten funktioniert dein Code genau so wie ich es haben sollte.
Gruss
Ben

Betrifft: demnach müsste es so funktionieren. von: Tino
Geschrieben am: 07.01.2010 11:28:07

Hallo,
teste mal mit diesem Code.

Private Sub Worksheet_Change(ByVal Target As Range)Dim rngZelle As Range'Eingabebereich Spalte D Set rngZelle = Intersect(Range("D6:D100"), Target)'Wurde in Spalte D was eingebeben? If Not rngZelle Is Nothing Then    'Schleife über die Eigebezellen in D     For Each rngZelle In rngZelle        'Wert aus Zeile R in der Eingabezeile von D         Select Case Cells(rngZelle.Row, 18).Value            Case "a"                Range(Cells(rngZelle.Row, 5), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4)).Interior.ColorIndex = 2            Case "b"                Range(Cells(rngZelle.Row, 5), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4)).Interior.ColorIndex = 3            Case "c"                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 37            Case "d"                Range(Cells(rngZelle.Row, 5), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 4)).Interior.ColorIndex = 35            Case "e"                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 6            Case "f"                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 15            Case Else                Range(Cells(rngZelle.Row, 3), Cells(rngZelle.Row, 16)).Interior.ColorIndex = 0        End Select    NextEnd IfEnd Sub

Gruß Tino

Betrifft: AW: demnach müsste es so funktionieren. von: Ben
Geschrieben am: 07.01.2010 11:40:23

Hi Tino
Ganz herzlichen Dank für die Hilfe. Jetzt passt es perfekt.
Gruss
Ben

Herbers Excel/VBA-Archiv

Der kurze Weg zum Ziel: Auftragsprogrammierung

Zeile aufgrund Werte einfärben | Herbers Excel-Forum