Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

VBA Colorarray

Betrifft: VBA Colorarray von: Peter
Geschrieben am: 16.09.2014 17:08:32

Kann sich jemand mit etwas mehr Einsicht einmal meine Tabelle anschauen und den Code troubleshooten? Ich bin recht unerfahren im Umgang mit dem Editor und würde das Modul gerne einsatzbereit machen. Evtl. gibt es auch etwas in den generellen Einstellungen zu berücksichtigen, was ich übersehen habe.. das weiß ich nicht.

Option Explicit
 
Sub Geldhaushalt()
   
  Dim rngCell As Excel.Range
   
  'erste Zelle referenzieren
  Set rngCell = Worksheets("Tabelle3").Range("I4")
   
  'solange verarbeiten bis Zelle leer ist
  Do Until IsEmpty(rngCell.Value)
     
    Select Case Trim$(rngCell.Text)
      'Gruppe 1
      Case "E1", "E2", "E3", "EE1", "EE2", "EE3", "EE4"
        rngCell.Interior.Color = RGB(0, 128, 0)
      'Gruppe 2
      Case "T1", "T2", "T3", "T4", "T5", "TT1", "TT2", "TT3"
        rngCell.Interior.Color = RGB(0, 204, 255)
      'Gruppe 3
      Case "Z1", "Z2", "Z3"
        rngCell.Interior.Color = RGB(153, 51, 0)
      'Gruppe 4
      Case "U1", "U2", "U3"
        rngCell.Interior.Color = RGB(153, 51, 102)
      'Gruppe 5
      Case "K", "TEC", "NEC"
        rngCell.Interior.Color = RGB(51, 51, 51)
      'Gruppe 6
      Case "STR", "ENT", "KUR", "SOF", "SER", "ORG", "RE"
        rngCell.Interior.Color = RGB(255, 0, 0)
      '.. und ansonsten
      Case Else
        rngCell.Interior.ColorIndex = xlColorIndexNone
    End Select
     
    'nächste Zelle referenzieren (= eine tiefer)
    Set rngCell = rngCell.Offset(RowOffset:=1)
  Loop
   
End Sub
Der Link zur Tabelle: https://www.herber.de/bbs/user/92665.xlsm

  

Betrifft: AW: VBA Colorarray von: Peter
Geschrieben am: 16.09.2014 17:19:01

Das Problem im speziellen ist, dass das Makro nicht automatisiert ist. Wenn ich es über den Developer Tab zum Laufen bringe und Eintragungen vorgenommen wurden funktioniert es soweit, aber es die Farbe erlischt nicht, wenn ich die Eintragungen wieder entferne. Ich möchte, dass es unabhängig von dem VBA Editor die Zellen bei Eingabe der Labels markiert.

Und noch eine Frage zu dem Code: Was muss ich codieren, dass die Textfarbe des Makros bei Eingabe schwarz und nach Eingabe in weiß erscheint?


  

Betrifft: 3 Fragen, 3 AWen, ... von: Luc:-?
Geschrieben am: 16.09.2014 17:36:18

…Peter:
1. Wenn das automatisch bei Eingabe erfolgen soll, musst du das Makro aus einer Workshee_Change-EreignisProzedur aufrufen.
2. Wenn sich die Farben automatisch bei EintragsEntfernung rückstellen sollen, verwendest du am Besten die BedingtFormatierung, die du auch per Makro setzen/erweitern kannst.
3. Der Editor kann mE nur manuell auf bestimmte Farben eingestellt wdn.
Gruß, Luc :-?


  

Betrifft: AW: 3 Fragen, 3 AWen, ... von: Peter
Geschrieben am: 16.09.2014 18:00:22

Danke vorab für die Hilfestellung! Reicht es aus, wenn ich die Linie

Sub Geldhaushalt()
durch
Private Sub Worksheet_Change.Geldhaushalt(ByVal Target As Range)
ersetze, oder verletze ich damit Codierungsrichtlinien im Bezug auf den restlichen Code?

Kann mir bitte jemand helfen, das in VBA abzubilden. Ich bin kein gelernter programmierer.


  

Betrifft: Das würde zwar reichen, aber die Prozedur ... von: Luc:-?
Geschrieben am: 16.09.2014 18:38:10

…(natürlich ohne .Geldhaushalt!) muss im DokumentKlassenModul des betroffenen Blattes (quasi auf seiner Rückseite) angelegt wdn, Peter;
da nur eine solche Prozedur pro Blatt angelegt wdn kann (plus 1 bei der Mappe und 1 zur Application), ist es meist günstiger, die als Verteiler zu benutzen und separate Makros aus ihr heraus (unter definierten Bedingungen → ggf Range-Objekt Target ⇒ die/der geänderte Zelle/Bereich benutzen) aufzurufen (Call Geldhaushalt).
Luc :-?


  

Betrifft: AW: Das würde zwar reichen, aber die Prozedur ... von: Peter
Geschrieben am: 16.09.2014 20:44:02

Habe meinen Code jetzt ein wenig angepasst mit Worksheet_Change und funktioniert auch schon recht gut, jedoch erlischt die Zellfarbe nur in Zelle I4 nach Löschung des Labels - nicht im restlichen Array (dort nur Zufallsbasiert und nicht durchgängig). Da hakt es noch irgendwie mit dem Code, kann mir das jemand korrigieren?

Der Bereich auf dem Blatt 3 ist I4-I1000.

Soweit ersteinmal die Änderung:

Option Explicit
  
Private Sub Worksheet_Change(ByVal Target As Range)
   
  Set Target = Intersect(Range(Cells(4, "I"), Cells(Rows.Count, "I").End(xlUp)), Target)
  If Target Is Nothing Then Exit Sub
   
  Dim rngCell As Excel.Range
   
  For Each rngCell In Target.Cells
     
    Select Case Trim$(rngCell.Text)
      'Gruppe 1
      Case "E1", "E2", "E3", "EE1", "EE2", "EE3", "EE4"
        rngCell.Interior.Color = RGB(0, 128, 0)
      'Gruppe 2
      Case "T1", "T2", "T3", "T4", "T5", "TT1", "TT2", "TT3"
        rngCell.Interior.Color = RGB(0, 204, 255)
      'Gruppe 3
      Case "Z1", "Z2", "Z3"
        rngCell.Interior.Color = RGB(153, 51, 0)
      'Gruppe 4
      Case "U1", "U2", "U3"
        rngCell.Interior.Color = RGB(153, 51, 102)
      'Gruppe 5
      Case "K", "TEC", "NEC"
        rngCell.Interior.Color = RGB(51, 51, 51)
      'Gruppe 6
      Case "STR", "ENT", "KUR", "SOF", "SER", "ORG", "RE"
        rngCell.Interior.Color = RGB(255, 0, 0)
      '.. und ansonsten
      Case Else
        rngCell.Interior.ColorIndex = xlColorIndexNone
    End Select
     
   Next
    
End Sub



  

Betrifft: AW: VBA Colorarray von: Ewald
Geschrieben am: 17.09.2014 23:07:35

Hallo Peter,

teste mal so

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngcell As Range
Dim Bereich As Range
Set Bereich = ActiveSheet.Range(Cells(4, 9), Cells(1000, 9))
If Target.Column = 9 Then
For Each rngcell In Bereich
        
        Select Case Trim$(rngcell.Value)
        
      'Gruppe 1
      Case "E1", "E2", "E3", "EE1", "EE2", "EE3", "EE4"
        rngcell.Interior.Color = RGB(0, 128, 0)
      'Gruppe 2
      Case "T1", "T2", "T3", "T4", "T5", "TT1", "TT2", "TT3"
        rngcell.Interior.Color = RGB(0, 204, 255)
      'Gruppe 3
      Case "Z1", "Z2", "Z3"
        rngcell.Interior.Color = RGB(153, 51, 0)
      'Gruppe 4
      Case "U1", "U2", "U3"
        rngcell.Interior.Color = RGB(153, 51, 102)
      'Gruppe 5
      Case "K", "TEC", "NEC"
        rngcell.Interior.Color = RGB(51, 51, 51)
      'Gruppe 6
      Case "STR", "ENT", "KUR", "SOF", "SER", "ORG", "RE"
        rngcell.Interior.Color = RGB(255, 0, 0)
      '.. und ansonsten
      Case ""
        rngcell.Interior.Color = xlNone
    End Select
Next
Set Bereich = Nothing
End If
End Sub
gruß Ewald