Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1012to1016
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

färben einer Zelle erweitern

färben einer Zelle erweitern
10.10.2008 06:54:00
Frank
Hallo zusammen
Ich habe folgende Frage. Ich möchte mit VBA Zellen einfärben. Was ich ja auch soweit schon am Laufen habe. Nun möchte ich aber das die Zelle gleich unterhalb der gefärbten ebenfalls eingefärbt wird und das auch so bleit wenn ich etwas anderes hineinschreibe. Was muss ich tun damit ich die Einfärbung erweitern kann?
Also A1 hat zB. Den Wert „N“ und die Zelle färbt ich ja auch schön Gelb nun soll A2 sich aber ebenfalls Gelb färben und so bleiben auch wenn ich in dieser Beispielsweise „krank“ schreibe.
Habt ihr eine Idee?
Soweit bin ich:

Private Sub Worksheet_Change(ByVal Ziel As Excel.Range)
Dim Bereich As Range
Dim rngZelle As Range
Set Bereich = ActiveSheet.Range("a1:ai34")
For Each rngZelle In Bereich
Select Case rngZelle
Case "F"
rngZelle.Interior.ColorIndex = 22
Case "N"
rngZelle.Interior.ColorIndex = 36
Case "S"
rngZelle.Interior.ColorIndex = 17
Case "zs"
rngZelle.Interior.ColorIndex = 15
Case "o"
rngZelle.Interior.ColorIndex = 45
Case Else
rngZelle.Interior.ColorIndex = xlNone
End Select
Next
End Sub


Gruß Frank
https://www.herber.de/bbs/user/55935.xls

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: färben einer Zelle erweitern
10.10.2008 08:37:55
Hajo_Zi
Hallo Frank,
klar ist mir nicht, wohr soll Excel Wissen das bei dieser Eingabe keine Fäebung erfolgen soll?
Gruß Hajo
AW: färben einer Zelle erweitern
10.10.2008 14:33:14
Frank
Hallo Hajo
Ich versteh deine Frage leider nicht so genau, aber wahrscheinlich habe ich mich auch falsch ausgedrückt.
Ganz einfach gesagt: Ich schreibe in Zelle A1 "N" , dann färbt sich die Zelle ich möchte aber auf Basis meines Code das sich die Zelle A2 ebenfalls färbt (bei Eingabe in A1), ohne in Zelle A2 einfach zu schreiben (=A1).
Gruß Frank
AW: färben einer Zelle erweitern
12.10.2008 12:32:00
Tino
Hallo,
so müsste es gehen.
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
      Dim Bereich As Range
      Dim rngZelle As Range
      
      Set Bereich = ActiveSheet.Range("a1:ai34")
      For Each rngZelle In Bereich
         With rngZelle.Offset(1, 0)
          Select Case rngZelle
              Case "F"
                  rngZelle.Interior.ColorIndex = 22
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case "N"
                  rngZelle.Interior.ColorIndex = 36
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case "S"
                  rngZelle.Interior.ColorIndex = 17
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case "zs"
                  rngZelle.Interior.ColorIndex = 15
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case "o"
                  rngZelle.Interior.ColorIndex = 45
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case Else
                  rngZelle.Interior.ColorIndex = xlNone
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
          End Select
         End With
      Next
End Sub


Gruß Tino

Anzeige
AW: färben einer Zelle erweitern
12.10.2008 12:33:22
Uwe
Hi Frank,
im Prinzip ist das mit .Offset lösbar. Allerdings würde Deine Case Else anweisung die Färbung der Zelle darunter sofort wieder löschen. Ich habe das Löschen deshalb vor der Schleife erledigt. Ist es das was Du erreichen wolltest?

Private Sub Worksheet_Change(ByVal Ziel As Excel.Range)
Dim Bereich As Range
Dim rngZelle As Range
Set Bereich = ActiveSheet.Range("a1:ai34")
Bereich.Interior.ColorIndex = xlNone    '!!!
For Each rngZelle In Bereich
Select Case rngZelle
Case "F"
rngZelle.Interior.ColorIndex = 22
rngZelle.Offset(1, 0).Interior.ColorIndex = 22
Case "N"
rngZelle.Interior.ColorIndex = 36
rngZelle.Offset(1, 0).Interior.ColorIndex = 36
Case "S"
rngZelle.Interior.ColorIndex = 17
rngZelle.Offset(1, 0).Interior.ColorIndex = 17
Case "zs"
rngZelle.Interior.ColorIndex = 15
rngZelle.Offset(1, 0).Interior.ColorIndex = 15
Case "o"
rngZelle.Interior.ColorIndex = 45
rngZelle.Offset(1, 0).Interior.ColorIndex = 45
'Case Else
'    rngZelle.Interior.ColorIndex = xlNone
End Select
Next
End Sub


Gruß
Uwe
(:o)

Anzeige
AW: färben einer Zelle erweitern
12.10.2008 13:10:00
Tino
Hallo,
genau stimmt, man könnte dies auch so machen.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
      Dim Bereich As Range
      Dim rngZelle As Range
      
      Set Bereich = ActiveSheet.Range("a1:ai34")
      For Each rngZelle In Bereich

       If rngZelle.Row Mod 2 > 0 Then 'Rest von Zeile / 2 
         With rngZelle.Offset(1, 0)
          Select Case rngZelle
              Case "F"
                  rngZelle.Interior.ColorIndex = 22
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case "N"
                  rngZelle.Interior.ColorIndex = 36
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case "S"
                  rngZelle.Interior.ColorIndex = 17
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case "zs"
                  rngZelle.Interior.ColorIndex = 15
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case "o"
                  rngZelle.Interior.ColorIndex = 45
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
              Case Else
                  rngZelle.Interior.ColorIndex = xlNone
                  .Interior.ColorIndex = rngZelle.Interior.ColorIndex
          End Select
         End With
        End If
      Next
End Sub


Gruß Tino

Anzeige
AW: färben einer Zelle erweitern
12.10.2008 15:11:00
Frank
Wow
Ich bin begeistert, so funktioniert es. Herzlichen Dank für eure Hilfe. Nun kann ich endlich weiter an meiner Liste arbeiten.
Gruß Frank

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige