Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1620to1624
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

BlockFormatierung grau-weiss mit Linien ergänzen

BlockFormatierung grau-weiss mit Linien ergänzen
29.04.2018 17:00:25
Peter
Hallo zusammen
Folgend den Link zur Bespieldatei: https://www.herber.de/bbs/user/121351.xlsm
In Reiter "Test" in Spalte C ist die übergeordnete und in Spalte D die untergeordnete Gruppe. Gerne möchte ich nun die Block-grau-weiss bedingte Formatierung nicht auf die übergeordnete Gruppe (Button "BlockFormatierung 1), sondern auf die untergeordnete Gruppe (BlockFormatierung 2) und die übergeordnete Gruppe soll mit einem schwarzen Rahmen abgegrenzt werden. Beispiel wie es aussehen soll, siehe Reiter "Ziel" in der Beispieldatei.
Die bedingte Formatierung funktioniert bereits gut, diese soll mit den Rahmen zeichnen für die übergeordnete Gruppe ergänzt werden. Ich habe es versucht dies zu integrieren, ist mir jedoch nicht gelungen, wie müsste ich folgenden Code abändern?
Sub BlockEinfaerben2()
Application.ScreenUpdating = False
'Variablen definieren
Dim Bereich 'Variable "Bereich"
Dim letzteZeile 'Variable "letzte Zeile"
Dim letzteSpalte 'Variable "letzte Spalte"
letzteZeile = Cells.Find("*", [A1], SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row
letzteSpalte = Cells.Find("*", [A1], SearchOrder:=xlByColumns, searchdirection:=xlPrevious). _
Column
Set Bereich = ActiveSheet.Range("$A$4:" & Cells(letzteZeile, letzteSpalte).Address) ' _
Variable Breich wird festgelegt, ab Zeile 2 + variable letzte Zeile und + varible letzte Spalte
'Alle bedingte Formatierung und Gitternetzlinien zuvor löschen
Cells.FormatConditions.Delete 'alle bedingten Formatierungen löschen
'Cells.Borders.LineStyle = xlNone  'alle Gitternetzlinien löschen
'Block gemäss Spalte D Zeilen grau/weiss formatieren
Bereich.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=REST(SUMMENPRODUKT(N($D$3:$D3$D$4:$D4));2)"   '

Danke im Voraus für jede Unterstützung.
Viele Grüsse
Peter

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: BlockFormatierung grau-weiss mit Linien ergänzen
30.04.2018 16:10:27
fcs
Hallo Peter,
bei bedingter Formatierung sind die Möglichkeiten die Rahmenlinien zu formatieren begrenzt.
Ich hab dein Makro mal angepasst/ergänzt.
Nicht erschrecken, wie die Formel generiert wird, aber so kann man variabel die Formeln an den zu formatierenden Bereich anpassen, ohne die Formel als festen Text im Code einzugeben.
Die Zell-Adressen für die Formel werden hier relativ zur 1. Zeile des zu formatierenden Bereichs angegeben.
Gruß
Franz
Sub BlockEinfaerben2()
Application.ScreenUpdating = False
'Variablen definieren
Dim Bereich As Range    'Variable für Zellbereich
Dim Zei_L               'Variable "letzte Zeile"
Dim Spa_L                'Variable "letzte Spalte"
Dim Zei_1 As Long, Spa_1 As Long 'Variable für 1. Zeile und 1. Spalte
Dim wks As Worksheet
Dim strFormel As String
Set wks = ActiveSheet
With wks
'Alle bedingten Zell-Formatierungen im Blatt löschen
.Cells.FormatConditions.Delete
Zei_1 = 6 '1. zu formatierende Zeile
Zei_L = .Cells.Find("*", .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row
Spa_L = .Cells.Find("*", .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, searchdirection:=xlPrevious).Column
'Block gemäss Spalte D Zeilen grau/weiss formatieren
Spa_1 = 4 'Spalte D - 1. Spalte des zu formatierenden Bereichs
'Variable Breich wird festgelegt
Set Bereich = .Range(.Cells(Zei_1, Spa_1), .Cells(Zei_L, Spa_L))
With Bereich
'Bedingte Formatierung
strFormel = "=REST(SUMMENPRODUKT(N(" & .Cells(-2, 1).Address(True, True, xlA1) & ":" _
_
& .Cells(0, 1).Address(False, True, xlA1) _
& "" & .Cells(-1, 1).Address(True, True, xlA1) & ":" _
& .Cells(1, 1).Address(False, True, xlA1) & "));2)"
.FormatConditions.Add Type:=xlExpression, Formula1:=strFormel
.FormatConditions(Bereich.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
End With
Spa_1 = 1 'Spalte A - 1. Spalte des zu formatierenden Bereichs
Set Bereich = .Range(.Cells(Zei_1, Spa_1), .Cells(Zei_L + 1, Spa_L))
With Bereich
'Bedingte Formatierung - Linien-Style setzen wenn Wert in Spalte D wechselt
strFormel = "=" & .Cells(0, 4).Address(False, True, xlA1) _
& "" & .Cells(1, 4).Address(False, True, xlA1)
.FormatConditions.Add Type:=xlExpression, Formula1:=strFormel
.FormatConditions(Bereich.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Borders(xlTop)
.LineStyle = xlDash
.ThemeColor = 2
.TintAndShade = 0
.Weight = xlThin
End With
.FormatConditions(1).StopIfTrue = False
'Bedingte Formatierung - Linien-Style setzen wenn Wert in Spalte C wechselt
strFormel = "=" & .Cells(0, 3).Address(False, True, xlA1) _
& "" & .Cells(1, 3).Address(False, True, xlA1)
.FormatConditions.Add Type:=xlExpression, Formula1:=strFormel
.FormatConditions(Bereich.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0
.Weight = xlThin
End With
.FormatConditions(1).StopIfTrue = False
End With
End With
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Anzeige
Super! noch eine kleine Frage, dicke anstatt dünne
30.04.2018 17:48:45
Peter
Hallo Franz
Wauh, funktioniert super, vielen Dank!
Eine kleine Frage habe ich noch:
- Anstatt eine gestrichelte Linie, eine dünne ausgezogene, das habe ich hinbekommen:
With .FormatConditions(1).Borders(xlTop)
'.LineStyle = xlDash
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0
.Weight = xlThin
End With
- Jedoch anstatt der dünnen Linie eine dickere, das habe ich nicht gebacken bekommen. Ich habe versucht .Weight = xlThin durch .Weight = xlMedium zu ersetzen, bekomme jedoch eine Fehlermeldung. Kannst Du mir das Script hier noch anpassen?
With .FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0
'.Weight = xlThin
.Weight = xlMedium
End With
Danke.
Vielen Grüsse,
Peter
Anzeige
AW: Super! noch eine kleine Frage, dicke anstatt dünne
30.04.2018 19:25:09
fcs
Hallo Peter,
wie schon erwähnt - die Möglichkeiten für die Rahmen sind unter bedingter Formatierung begrenzt.
Man kann die Breite (Weight) der Linien nicht vergrößern über xlThin hinaus.
xlHairline ist noch möglich für sehr dünne Linien.
Für breitere Trennlinien müsste man die Linien fest reinformatieren.
Also zuerst alle horizontalen Rahmen-Linien auf ein Einheitsformat setzen und dann zeilenweise prüfen, ob sich der Wert in Spalte D oder C ändert und dann den Rahmen entsprechend formatieren.
Nachfolgend das entsprechend angepasste Makro.
Gruß
Franz
Sub BlockEinfaerben2()
Application.ScreenUpdating = False
'Variablen definieren
Dim Bereich As Range    'Variable für Zellbereich
Dim Zei As Long
Dim Zei_L               'Variable "letzte Zeile"
Dim Spa_L                'Variable "letzte Spalte"
Dim Zei_1 As Long, Spa_1 As Long 'Variable für 1. Zeile und 1. Spalte
Dim wks As Worksheet
Dim strFormel As String
Dim varWeight
Set wks = ActiveSheet
With wks
'Alle bedingten Zell-Formatierungen im Blatt löschen
.Cells.FormatConditions.Delete
Zei_1 = 6 '1. zu formatierende Zeile
Zei_L = .Cells.Find("*", .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row
Spa_L = .Cells.Find("*", .Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByColumns, searchdirection:=xlPrevious).Column
'Block gemäss Spalte D Zeilen grau/weiss formatieren
Spa_1 = 4 'Spalte D - 1. Spalte des zu formatierenden Bereichs
'Variable Breich wird festgelegt
Set Bereich = .Range(.Cells(Zei_1, Spa_1), .Cells(Zei_L, Spa_L))
With Bereich
'Bedingte Formatierung
strFormel = "=REST(SUMMENPRODUKT(N(" & .Cells(-2, 1).Address(True, True, xlA1) _
& ":" & .Cells(0, 1).Address(False, True, xlA1) _
& "" & .Cells(-1, 1).Address(True, True, xlA1) & ":" _
& .Cells(1, 1).Address(False, True, xlA1) & "));2)"
.FormatConditions.Add Type:=xlExpression, Formula1:=strFormel
.FormatConditions(Bereich.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
End With
Spa_1 = 1 'Spalte A - 1. Spalte des zu formatierenden Bereichs
Set Bereich = .Range(.Cells(Zei_1, Spa_1), .Cells(Zei_L, Spa_L))
With Bereich
'Alle inneren horizontalen Linien Formatieren
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.Color = RGB(166, 166, 166) 'grau
End With
End With
varWeight = "A"
For Zei = Zei_1 To Zei_L + 1
If .Cells(Zei - 1, 3).Value  .Cells(Zei, 3).Value Then
'Spalte C hat sich geändert
varWeight = xlMedium
ElseIf .Cells(Zei - 1, 4).Value  .Cells(Zei, 4).Value Then
'Spalte D hat sich geändert
varWeight = xlThin
End If
If varWeight  "A" Then
With .Range(.Cells(Zei - 1, Spa_1), .Cells(Zei, Spa_L))
'innere horizontale Linie Formatieren
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = varWeight
.Color = RGB(0, 0, 0) 'schwarz
End With
End With
varWeight = "A"
End If
Next
End With
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Super! noch eine kleine Frage, dicke anstatt dünne
01.05.2018 09:28:52
Peter
Hallo Franz
Super, echt super, danke Dir!
Viele Grüsse,
Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige