Wenn Abfrage

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Jens,
nach einer Lösung mit einem Makro war in deiner Frage ja auch nicht gefragt.
Mit Sepps Vorschlag kansst du das Einfärben per bedingter Formatierung steuern, wobei die Bedigung mit der SUMMENPRODUKT-Formel die besser geeignete ist, da sie auf den gesamten Bereich H2:Z24 angewendet werden kann. ggf. muss diese Bedingung an die 1. Position verschoben werden. DIe Bedingungen lassen sich auch etwas einfacher strukturieren.
Gruß
Franz
Tabelle1

	A	B	C	D	E	F	G	H
1			Name					KW18
2		A						-1,0

Bedingte Formatierungen der Tabelle

Zelle	Nr.: / Bedingung	Format
H2	1. / Formel ist =SUMMENPRODUKT((H$2:H$24="")*($C$2:$C$24=$C2))=ZÄHLENWENN($C$2:$C$24;$C2)	Abc
H2	2. / Formel ist =UND($B2<>"";H2>0)	Abc
H2	3. / Formel ist =UND($B2<>"";H2<0)	Abc

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Userbild

Hallo Jens,
hier ein Makro mit entsprechenden Prüfungen und Formatierungsanweisung.
Kleines Problem:
Viele scheinbar leere Zellen enthalten noch Leerstrings.
Einige Zellen in der 1. Maneszeile eines Blocks enthalten für die KW den Wert 0, solche KW werden nicht als Urlaub gekennzeichnet.
Gruß
Franz Sub Formatieren_Urlaub() Dim wks As Worksheet Dim Zeile_1 As Long '1. zu prüfende Zeile Dim Zeile_L As Long 'Letzte Daten Zeile (Name in Spalte C) Dim Zeile_N1 As Long '1. Zeile im Namens Block (Orange) Dim Zeile_NL As Long 'Letzte Zeile im Namens Block Dim Spalte_N As Long 'Spalte mit 1. Name im Block Dim Spalte_KW1 As Long 'Spalte mit 1. KW Dim Spalte_KWL As Long 'Spalte mit Letzter KW in Zeile 1 Dim Zeile As Long, Spalte As Long Set wks = ActiveSheet Application.ScreenUpdating = False With wks 'vorgegeben Zeilen und Spalten setzen Zeile_1 = 2 '1. zu prüfende Zeile Spalte_N = 2 'Spalte B - Spalte mit den Namen in 1. Zeile eines Block Spalte_KW1 = 8 'Spalte H - Spalte mit 1. KW 'Letzte Zeile und Spalte mit Daten ermitteln 'Letzte Datenzeile in Spalte C Zeile_L = .Cells(.Rows.Count, 3).End(xlUp).Row 'Letzte Datenspalte in Zeile 1 Spalte_KWL = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Datenzeilen abarbeiten For Zeile = Zeile_1 To Zeile_L 'prüfen, ob in Spalte B ein neuer Namensblock beginnt oder letzte Zeile erreicht ist If .Cells(Zeile, Spalte_N) "" Or Zeile = Zeile_L Then If Zeile = Zeile_L Then Zeile_NL = Zeile_L If Zeile > Zeile_1 And Zeile_NL > Zeile_N1 Then 'Spalten mit KW abarbeiten For Spalte = Spalte_KW1 To Spalte_KWL 'Prüfen, ob in 1. Zeile des Namens zur KW die Zelle leer ist If .Cells(Zeile_N1, Spalte) = "" Then With .Range(.Cells(Zeile_N1 + 1, Spalte), .Cells(Zeile_NL, Spalte)) If Application.WorksheetFunction.CountIf(.Cells, "") = Zeile_NL - Zeile_N1 Then .Interior.Color = 10498160 'lila End If End With End If Next Spalte End If '1. Zeile des Namensblocks merken Zeile_N1 = Zeile 'letzte Zeile des Namensblockes zurücksetzen setzen Zeile_NL = Zeile_N1 Else 'letzte Zeile des Namensblockes neu setzen Zeile_NL = Zeile End If Next Zeile End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread