Tab Farbe nach Datum ändern - VBA

[amaxx]

Hallo

Ich bin auf der Suche nach einem Makro, mit dem ich die Register Tabs färben kann.

Die Datei behinhaltet 31 Tabs für die Tage eines Monats, ich möchte die Wochenenden/Feiertage automatisch einfärben. Hierzu habe ich bereits Kalender, der für Samstag, Sonntag und Feiertage den Wert WAHR in einer Zelle ausgibt, für Werktage FALSCH, der Code muss also nur in jedem Arbeitsblatt nach dem Wert Wahr oder Falsch suchen, und dementsprechend den Tabs Farben verpassen.

Erstelle ich eine neue Datei für einen neuen Monat, sollen sich die Farben der Tabs dann natürlich ebenfalls ändern.

Danke

Gruß amaxx

[RPP63]

Moin!
Warum nicht auf einem Blatt? Und dann eine bedingte Formatierung nebst folgender Filterung oder Pivot-Table?
Die Tabellenblätter in Excel sollten so behandelt werden wie in einer "richtigen" Datenbank.
Man kann bis zur dritten Normalform das Ganze quasi-relational aufbauen.
https://de.wikipedia.org/wiki/Normalisie...tenbank%29

Alles andere ist (nicht nur) in meinen Augen Klicki-Bunti und hat mit vernünftiger Datenhaltung nüscht zu tun.

Two Cents,
Ralf

[amaxx]

Danke für deinen Beitrag, leider hast Du das Thema verfehlt!

Überlass doch bitte die Gestaltung der Tabelle mir, da Du nicht weißt, um was es hier eigentlich geht, es soll schliesslich übersichtlich bleiben und auf einem Blatt ist schon genug drauf!

Ich optimiere für einen Kollegen diese Tabelle zur Qualitätskontrolle einer Produktionsanlage, die sich optisch zwar kaum von seiner alten unterscheidet, jedoch die Arbeit deutlich erleichtern soll, nachdem ich mir 2 Wochen lang angeschaut habe :19: , wie jemand ohne Ahnung von Copy/Paste 50000 Felder per Hand für das letzte Jahr ausgefüllt hat und jedes Tab einzeln eingefärbt hat :16: , wenn ich nun anfange die komplette Tabelle auf einem Blatt umzustellen, nur weil Du meinst dass es besser ist, dann habe ich das Thema verfehlt!

Ich habe eine sachliche Vorgabe gegeben und erwarte nun kurz und knapp Vorschläge von jemand, der sich mit VBA besser auskennt als ich, auf offtopic Vorschläge würde ich hierbei gerne verzichten. Danke

[Ego]

Hallo Amaxx,

wenn du in den verschiedenen Arbeitsblättern gleichartige Daten verwalten willst, hast du das Thema wirklich verfehlt.
Anstatt Excel könntest du auch Papyrusblätter nutzen.

Wieso sollten wir jemanden helfen, der so auf einen vernünftigen Vorschlag reagiert?

Ein Zusammenfassen gleichartiger Daten in eine und nur eine Tabelle erleichtert die Arbeiten ungemein.

[atilla]

Hallo,

und warum können Anregungen zu anderen Lösungswegen nicht gemacht werden.?
Das hört sich fast so an, haben wir immer schon so gemacht.....

Gedanken sind frei und können insprierend sein.

Bevor Du mich jetzt auch anmaulst, unten ein Code der so etwas macht, was Du möchtest.
Der guckt in jedem Blatt ob in Zelle(Zeile 1, Spalte 1) ein "Falsch" steht. Wenn ja, dann wird das Blatt rot sonst erblast es und wird gelb.

Code:

Sub register_farbe()
 Dim i As Long
 For i = 1 To Sheets.Count
   If Sheets(i).Cells(1, 1).Value = "Falsch" Then
     Sheets(i).Tab.ColorIndex = 3
   Else
     Sheets(i).Tab.ColorIndex = 6
   End If
 Next i
End Sub

[amaxx]

Danke Atilla, das ist genau was ich gesucht habe!


Inzwischen hätte ich jedoch gerne außerdem noch die Möglichkeit weitere Farben darzustellen, also nicht nur entweder diese oder die andere (wahr/falsch), sondern 3 oder 4, nachdem nun auch andere Kollegen einer weiteren Abteilung so begeistert davon sind, dass sie dies nun ebenfalls in Ihrer Produktionsübersicht haben wollen.
Wie müßte hierfür die Formel bitte erweitert werden?

Des Weiteren fänd ich es auch noch cool, wenn direkt nach Eingabe des Datums das Makro ausgelöst wird, im Moment hab ich nur nen Button neben dem Datum.

Ich finde es nicht so schlimm, dass die Tabs Tagesbezogen sind, auch wenn man so zwar sehr viele Tabs hat, so sind sie dennoch leicht zu finden und man kann recht gut den Überblick behalten.
Natürlich bin ich auch offen für neue Vorschläge, aber da ich das in diesem Fall ohnehin nur auf Wunsch für eine andere Abteilung mache, die mit den alten Tabellen ansonsten zufrieden sind, warum sollte ich da alles ändern und die Leute eingwöhnen? Bis vor 2 Jahren wurde diese Arbeit sogar tatsächlich noch auf "Papyrus" gemacht, bis hier einer mal ne Tabelle erstellt hat, die jedoch bisher mit sehr viel Arbeit verbunden war, da auf 31 Tabs nicht eine einzige Formel drauf war und wirklich nur Papier ersetzt hatte. Jetzt hat die ganze Datei einen echten Mehrwert mit Auswertungen und Statistiken.

@Ego: Es ist nicht bloß EINE Datenbank, es sind pro Tag/Tab 3 größere Tabellen, für je 3 Schichten, wo diverse Mängel produktbezogen festgehalten und nun auch vernünftig ausgelesen werden, das alles nun auf eine Seite zu quetschen fänd ich selbst nicht gut, dennoch Danke für den Vorschlag.


PS: Sorry, falls es so rüber kam, aber das war defintiv kein Maulen! Ich finde es halt nicht wirklich sooo Ideal, wenn man nach dem Wetter fragt und zur Antwort Aktienkurse vorgelesen bekommt.

[atilla]

Hallo,

das sind zu ungenaue Angaben. Ich weiß nicht, wo Daten stehen.

Unten Beispielhaft Code, welcher in jeder der Tabellen automatisch angestoßen wird, sobald der Inhalt der Zelle A1 geändert wird.

Code:

'Code ins Codemodul "DieseArbeitsmappe"
'dieser Code reagiert automatisch auf die Änderung der Zelle A1 IN JEDER TABELLE
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Code reagiert auf Ändrung der Zelle A1, gegebenenfalls anpassen
 If Target.Address(0, 0) = "A1" And Target <> "" Then
   If IsDate(Target) Then
     register_farbe_Alle_Tabellen    'entweder diese Zeile
     register_farbe_aktive_tabelle   'oder diese Zeile
   End If
 End If
End Sub

Im obigen Code werden zwei Routinen aufgerufen.
Das wären diese:

Code:

Sub register_farbe_Alle_Tabellen()
'alle Reiter  werden anhand des Wertes in A1 gefärbt
Dim i As Long
For i = 1 To Sheets.Count
  Select Case Sheets(i).Cells(1, 1).Value
   Case Is = "Falsch"
    Sheets(i).Tab.ColorIndex = 3
   Case Is = "True"
    Sheets(i).Tab.ColorIndex = 10
   Case Is = 3
     Sheets(i).Tab.ColorIndex = 22
   '....usw
  End Select
Next i
End Sub

Sub register_farbe_aktive_tabelle()
 'nur der Reiter der aktive Tabelle wird anhand des Wertes in A1 gefärbt
 With ActiveSheet
    Select Case Cells(1, 1).Value
     Case Is = "Falsch"
      .Tab.ColorIndex = 3
     Case Is = "True"
      .Tab.ColorIndex = 10
     Case Is = 3
       .Tab.ColorIndex = 22
     '....usw
    End Select
 End With
End Sub

Du entscheidest Dich im ersten Code, welche Routine automatisch angestoßen werden soll und löschst dann die Zeile für die andere Routine.