Tabellenblätter nach Farbe sortieren
01.02.2014 15:58:37
Maik
ich stelle dir Frage nochmals rein (gabs schon von mir, kann da aber leider nicht mehr kommentieren). Es geht um folgendes (copy paste aus dem alten Beitrag):
Ich habe in meiner Kostenkalkulation alle Mitarbeiter stehen. Die Farbe eines jeden Tabellenblatt - Mitarbeiters ändert sich je nach Aufgabengebiet:
Verwaltung - ORANGE
Design - Blau
Entwicklung - GRÜN
Projektmanagement - GELB
Entlassen - ROT
Zur besseren Veranschaulichung hier ein Screenshot:
https://dl.dropboxusercontent.com/u/32990230/Herber_Screenshot.png
Funktioniert tadellos. Bin happy damit. Um den Grad der Automatisierung noch nach vorne zu treiben wäre es super wenn sich die Farben automatisch ordnen könnten.
Fall 1:
Ich entlasse einen Mitarbeiter aus dem Design, dafür tippe ich ein Datum ein und die Tabellenblattfarbe ändert sich bisher schon automatisch in ROT:
Wäre es dann möglich, dass das Blatt wenn es ROT ist auch automatisch nach hinten wandert (Am besten vor die Folie "Ende" die ich nur als Stopper-Folie einsetze um zwischen "Personal" und "Ende" Werte zu addieren)
Fall 2:
Ein Mitarbeiter wechselt intern den Bereich (ja das kommt vor)
Wäre es dann möglich, das er sich je nach Bereich/Tabellenblattfarbe neu einsortiert?
Beispiel: "MarGe" wechselt von "Design" in "Entwicklung". Dafür gehe ich in die "MarGe" Folie und wähle per Dropdown den neuen Bereich aus. SCHWUPPS jetzt müsste MarGe hinter "PetSc" (Siehe Entwicklung) rutschen.
Hier wie mein Code aktuell aussieht:
- Sub 1 und 2 funktionieren tadellos.
Private Sub Worksheet_Calculate()
If Range("AD4") = "aktiv" And Range("B6") = "1" Then Me.Tab.ColorIndex = 42
If Range("AD4") = "aktiv" And Range("B6") = "2" Then Me.Tab.ColorIndex = 43
If Range("AD4") = "aktiv" And Range("B6") = "3" Then Me.Tab.ColorIndex = 44
If Range("AD4") = "aktiv" And Range("B6") = "4" Then Me.Tab.ColorIndex = 45
If Range("AD4") = "inaktiv" Then Me.Tab.ColorIndex = 3
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Name = Range("G1").Text
End Sub
Sub SheetSortColor()
Dim x As Integer, y As Integer, wsCount As Integer
wsCount = ActiveWorkbook.Worksheets.Count
For x = 1 To wsCount
For y = x To wsCount
If Worksheets(y).Tab.Color Worksheets(y).Move before:=Worksheets(x)
End If
Next y
Next x
End Sub
Anzeige