Makro: bedingte Formatierung löschen / neu setzen
23.04.2015 10:53:39
Michl
ich hatte mir hier letztens bzgl. einer bedingten Formatierung helfen lassen. Der entsprechende Link zum Archivbeitrag ist folgender: https://www.herber.de/forum/archiv/1416to1420/t1418658.htm
Hier hatte Klexy folgendes Makro zur Verfügung gestellt.
Sub Bedingte_Formatierung_reparieren()
Dim ObenLinks As Range, Tabellenbreite As Integer
'erste Zelle im formatierten Bereich (normalerweise A2)
Set ObenLinks = Range("A2")
'Das muss an einer durchgehenden Zeile, normalerweise der Tabellenkopf in Zeile 1 gemacht _
_
_
werden.
Tabellenbreite = ObenLinks.Offset(-1, 0).End(xlToRight).Column
'das fängt Leerzeilen mitten in der Tabelle ab, indem ein Punkt eingefügt wird, wenn leer
ObenLinks.EntireColumn.Select
Selection.Replace What:="", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'bedingte Formatierungen überall außer in der ersten Zeile löschen
Range(ObenLinks.Offset(1, 0), ObenLinks.Offset(1, 0).End(xlDown).Offset(0, Tabellenbreite - _
_
_
1)).Select
Selection.FormatConditions.Delete
'bedingte Formatierungen aus der ersten Zeile kopieren
Range(ObenLinks, ObenLinks.Offset(0, Tabellenbreite - 1)).Select
Calculate
Selection.Copy
'bedingte Formatierungen auf die ganze Tabelle verschieben
Range(ObenLinks, ObenLinks.End(xlDown).Offset(0, Tabellenbreite - 1)).Select
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
'löscht die Punkte von vorhin wieder
ObenLinks.EntireColumn.Select
Selection.Replace What:=".", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ObenLinks.Select
End Sub
Nun meine Frage: Dieses Makro löscht alle Formatierungen, egal ob bedingt oder nicht. Würde dies auch so funktionieren, dass manuell gesetzte Formatierungen beibehalten werden, während nur die bedingten Formatierungen gelöscht und neu gesetzt werden?