Fette Rahmenlinien bei bedingter Formatierung

Hallo zusammen,
ich verwende ein Makro zum formatieren einer Tabelle, um sie übersichtlicher zu gestalten. In Spalte E sind untereinander Projektnamen eingetragen. Ändert sich der Projektname in der Spalte, sollen die Zeilen u.a. durch eine fette Linie getrennt werden. Mein Makro funktioniert super, wenn in den Zellen der Tabelle keine bedingten Formatierungen hinterlegt sind. Ist eine bedingte Formatierung in der Zelle enthalten, wird die Rahmenlinie nicht gezeichnet.
Hat jemand einen Tipp, wie ich die Trennlinien "durchgehend" in die Tabelle bekomme?
Viele Grüße
trine
Mein Makro sieht so aus:


Sub test()
Rows("22:5000").Select
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Columns("A:A").Select
Selection.ClearContents
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("E22:E5000").Select
Selection.Copy
Range("A22:A5000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A22:BE5000").Select
ActiveWorkbook.Worksheets("Projekt").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Projekt").Sort.SortFields.Add Key:=Range("E22:E5000"), SortOn:=   _
_
_
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Projekt").Sort.SortFields.Add Key:=Range( _
"BD22:BD50"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Projekt").Sort
.SetRange Range("A22:BE5000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim Zelle1 As Range
Dim Zelle2 As Range
Set Zelle1 = Cells(22, 1) 'Startzelle
Do While Zelle1.Value  ""
Set Zelle2 = Zelle1.EntireColumn.Find(what:=Zelle1.Value, lookat:=xlWhole, searchdirection:= _
_
_
xlPrevious)
If Zelle2.Row > Zelle1.Row Then
Range(Zelle1.Offset(1, 0), Zelle2).ClearContents
Range(Zelle1, Zelle2).Merge
End If
Set Zelle1 = Zelle2.Offset(1, 0)
Loop
Dim aletzte As Long
Dim rng As Range
With ActiveSheet
' letzte benutzte Zeile ermitteln
aletzte = .Cells(Rows.Count, 5).End(xlUp).Row
With .Range("A22:CS" & aletzte)
.BorderAround LineStyle:=xlThin
.Borders(xlInsideHorizontal).LineStyle = xlThin
'.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideHorizontal).ColorIndex = 15
'.Borders(xlInsideVertical).LineStyle = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlInsideVertical).ColorIndex = 15
.Borders(xlEdgeBottom).Weight = xlThick
End With
'' für jede weitere Zeile prüfen, ob ein neuer Tag beginnt
For Each rng In .Range("E22:E" & aletzte)
' tag darunter ungleich Tag darüber und Tag darunter nicht leer ?
If rng.Offset(1, 0).Value  rng.Value And rng.Offset(1, 0).Value  "" Then
' Strich ziehen ...
.Range(.Cells(rng.Row, 1), .Cells(rng.Row, 143)) _
.Borders(xlEdgeBottom).Weight = xlThick
.Range(.Cells(rng.Row, 1), .Cells(rng.Row, 143)) _
.Borders(xlEdgeBottom).ColorIndex = 1
End If
Next rng
End With
End Sub

Hallo Luc,
ich habe die Zellrahmen aus der bedingten Formatierung rausgenommen, das hat leider nicht funktioniert. Jetzt habe ich die versucht, die Bedingte Formatierung in VBA zu schreiben. Wenn ich nur Fette Rahmen zeichnen will, funktioniert mein Code. Ich bekomme es aber nicht hin mit der zweiten Bedingung (priorität nach den fetten Rahmen),die Zelle einzufärben, wenn der Zellwert größer als "0" ist.
Kann mir da jemand weiterhelfen?
Mein Code sieht dafür so aus:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Range("BG22:BQ44").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=nicht($E22=$E23)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Borders(xlBottom).Weight = xlThick
End With
Range("BG22:BQ44").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=(NICHT(BG22=0)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599963377788629
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599963377788629
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub

Fette Rahmenlinien bei bedingter Formatierung

Forumthread: Fette Rahmenlinien bei bedingter Formatierung

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial