AW: bedingte Formatierung
03.01.2019 13:40:09
Steve
Na dann mal los...
Vielleicht zwei Worte vorweg:
Es geht um ein Theater.
Es gibt eine Tabelle (sheet4) mit dem Namen STÜCKE.
In dieser stehen in den Spalten die Spieler und in den Zeilen die Stücke.
Aktuell gibt es 10 Stücke und 15 Spieler.
Pro inszenierung sind maximal 6 Spieler beteiligt.
Das System ist aber skalierbar angelegt (mehr oder weniger Stücke, mehr oder weniger Spieler)
In den einzelnen Feldern der Tabelle STÜCKE steht unter anderm EB, was Erstbesetzung heisst.
Ausserdem verwende ich hier ein ARRAY namens STUECKE(i,j), mit dem ich die Tabelle STÜCKE in kurzform abbilde (i Stücke, j =1 Stückname, J=2-7 Spielerspaltennummern, J=8 Formatierungsfarbe)
Die obenstende Funktion Farbe_Net versucht nun in Tabelle1 über bedingte Formatierung die Spieler einzufärben, falls in Spalte U die Abkürzung des Stück eingesetzt wird (Das Stück angesetzt wird).
Auch in Tabelle 1 stehen die Spielernamen oben in einer Zeile
Die Zeilen allerdings entsprechen Daten.
In Spalte U wird nun ebenfalls die Abkürzung des Namens eines Stücks pro Datum eingesetzt.
Dann sollen sich alle Felder in den Spalten der Spieler in der Farbe des Stück einfärben.
Das gelingt aber nur, wenn kein Spieler dieses Stücks an diesem Tag gesperrt ist (in diesem Fall steht bei dem Spieler ein G wie gesperrt an diesem Tag in der entsprechenden Spalte.
IST EIN SPIELER GESPERRT, FÄRBT SICH KEIN SPIELER EIN, ist keiner gesperrt, färben sich alle ein...
Das ganze ist natürlich Teil eines viel größeren Projektes. Bisher habe ich die (vielen, vielen) bedingten Formatierungen per Hand eingegebn. das versuche ich nun zu automatisieren...
Ziemlich am Ende gibt es eine debug.print Anweisung zum Testen, die ich als Kommentar stehen habe. Falls Ihr es ausprobieren wollt: diese liefert exakt die Formel.
Ich habe auch testweise über die MsgBox ausgegeben oder über eine Zelle in der Tabelle. das Ergebnis war immer richtig.
Vielleicht liegt es auch an den Variablentypen?
Public Function FormelAusgebenII(n As Integer) As String
'Gibt eine bedingte Formatierung aus für das Stück n+4; n=1 to Anzahl Stücke LZ
Dim LZ, LS, i, j, h As Integer
Dim STUECKE() As Variant
LZ = 0
LZ = Workbooks("Test.xlsm").Worksheets("Tabelle1").FIND_EMPTY_ROW() 'LZ=Letzte Zeile vor der _
ersten Leeren Zeile
LS = 0
LS = Workbooks("Test.xlsm").Worksheets("Tabelle1").FIND_EMPTY_COLUMN() 'LS=Letzte Spalte vor _
der letzten leeren Spalte
ReDim STUECKE(LZ - 4, 8) 'In diesem Array werdem jedem Stück aus der Tabelle "STÜCKE" (Sheet( _
4)) das Stück auf der n.ten Position der Tabelle STÜCKE zugewiesen, die Spaltennummern der beteiligten Spieler sowie die zu verwendende Farbe zugeordnet.
Auf der Position STÜCKE(n,1) findet sich die Abkürzung des Stückenamens, STÜCKE(n,2...7) sind _
die Spaltennummern der maximal 6 der Spieler, STÜCKE(n,8) beinhaltet die Farbe des Stückes, mit der in Tabelle1 am Veranstaltungstag über bedingte Formatierung die Spielerspalten eingefärbt werden.
Tabelle STÜCKE beginnt erst bei Zeile 4;
h = 1
i = n
STUECKE(i, 1) = Workbooks("Test.xlsm").Worksheets(4).Cells(i + 3, 1).Value
'Name des Stückes da immer höchstens 6 Spieler dabei sind wir das 7. Feld nie gebraucht
STUECKE(i, 8) = Workbooks("Test.xlsm").Worksheets(1).Farbe3(i + 3, 1)
'da immer höchstens 6 Spieler dabei sind wir das 7. Feld nie gebraucht
For j = 2 To LS 'Tabelle STÜCKE beginnt erst in der zweiten Spalte
If IsEmpty(Workbooks("Test.xlsm").Worksheets(4).Cells(i + 3, j).Value) Then
'nothing
Else
If Workbooks("Test.xlsm").Worksheets(4).Cells(i + 3, j).Value = "EB" Then
'EB=Erstbesetzung
h = h + 1
STUECKE(i, h) = j + 3
'h spart die leeren Spalten aus, so dass immer die ersten Felder gefüllt _
sind und addiert bei j gleich 4 dazu, da die spalten in SpielPlaner im Vergleich zu STÜCKE um 3 verschoben sind
End If
End If
Next j
' Debug.Print Chr(34) & "= UND(U1 = " & """""" & STUECKE(i, 1) & """""" & " ; " & Workbooks(" _
Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 2)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 3)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 4)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; "; Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 5)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 6)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 7)) & "1 """"" & "G" & Chr(34) & Chr(34) & ")" & Chr(34)
FormelAusgebenII = Chr(34) & "= UND(U1 = " & """""" & STUECKE(i, 1) & """""" & " ; " & _
Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 2)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 3)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 4)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 5)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 6)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 7)) & "1 """"" & "G" & Chr(34) & Chr(34) & ")" & Chr(34)
' Workbooks("Test.xlsm").Worksheets(1).Cells(20, 1) = Chr(34) & "= UND(U1 = " & """""" & _
STUECKE(i, 1) & """""" & " ; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 2)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 3)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 4)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 5)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 6)) & "1 """"" & "G" & Chr(34) & Chr(34) & "; " & Workbooks("Test.xlsm").Worksheets(1).spaltenbuchstabe(STUECKE(i, 7)) & "1 """"" & "G" & Chr(34) & Chr(34) & ")" & Chr(34)
End Function