Conditional Formatting in Abhängigkeit der Spaltenüberschrift

[YvonneW]

Hallo liebe Excel-Spezialisten

Hoffe Ihr könnt mir bei einem für mich kniffeligen Thema helfen.

Ich arbeite mit einem Makro, welches mir bestimmte Spalten mit einer bedingten Formatierung belegt.
Dabei sind unterschiedliche Spalten mit unterschiedlichen Bedingungen belegt,
aber auch oft mehrere Spalten mit der gelichen Bediingung (sh. ModulConditionalFormatting).
Das File wird von mehreren Kollegen aktualisiert, wobei neue Zeilen eingefügt werden, Infos aus anderen Zeilen einkopiert werden etc.
Desweiteren kommen oft Spalten hinzu und andere werden gelöscht.
[
Bild bitte so als Datei hochladen: Klick mich!
]

Um nun das Makro nicht jedesmal bezüglich der Spalten umzuschreiben, will ich die Spalten in Abhängigkeit der Spaltenüberschrift mit der bedingten Formatierung belegen.
Ein Makro hierzu, habe ich schon mit Hilfe eines Freundes geschrieben (sh. ModulConditionalFormattingTest).
Dies funktioniert zwar, allerdings werden viele bedingte Formatierungen erzeugt, da jede Spalte einzeln angesprochen wird.
Soweit ich weiß müssten die zu markierenden Spalten in ein Array geschrieben werden, habe jedoch keine Ahnung wie das geht.
[
Bild bitte so als Datei hochladen: Klick mich!
]

Ich arbeite in der Firma mit Excel 2013, zuhause mit Excel 2016 und manchmal noch mit Excel 2007.

Anbei das sehr abgespeckte File mit 2 Makros (mit Bezug auf Spalten, mit Bezug auf Überschriften).

  xFile Conditional Formatting.xlsm (Größe: 31,64 KB / Downloads: 11)

Vielen Dank schon mal im Voraus für Eure Hilfe.

[Rabe]

Hi Yvonne,

Hoffe Ihr könnt mir bei einem für mich kniffeligen Thema helfen.

Ich arbeite mit einem Makro, welches mir bestimmte Spalten mit einer bedingten Formatierung belegt.

Das Thema klingt sehr interessant.

Aber meine Überlegung:
Wenn Du eh mit Makro arbeitest, kannst Du da nicht auf die bedingte Formatierung komplett verzichten und die Einfärbung der Zellen gleich durch das Makro erledigen lassen?

[YvonneW]

Hi Yvonne,


Das Thema klingt sehr interessant.

Aber meine Überlegung:
Wenn Du eh mit Makro arbeitest, kannst Du da nicht auf die bedingte Formatierung komplett verzichten und die Einfärbung der Zellen gleich durch das Makro erledigen lassen?

Hi Ralf
Bin mir nicht sicher ob das Sinn macht, da in den entsprechenden Spalten auch oft neue Werte eingetragen werden.
Dann müsste jeder User das Makro nach Änderungen durchlaufen lassen, oder verstehe ich das falsch?

LG Yvonne

[schauan]

Hallöchen,

da kann auch der Makrorekorder helfen. Aufgezeichnet bekommst DU in etwa so etwas angeboten:

Code:

Sub Makro2()
'
' Makro2 Makro
'

'
   Range("A10,E:E,G:G,I:I").Select
   Range("I1").Activate
End Sub

Relevant wäre dann das:
   Range("E:E,G:G,I:I").Select

Wobei man mit den Selections sparsam umgehen kann. Probiere einfach mal aus, die zusammengehörenden Zeilen mit Select und Selection zusammenzufassen, z.B.

Range("E:E,G:G,I:I").Select
Selection.FormatConditions.Add ...

in

Range("E:E,G:G,I:I").FormatConditions.Add ...

Da die Selection in Folge noch öfter gebraucht wird, geht das auch so:

Code:

      With Range("E:E,G:G,I:I")
         .FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=-0,15"
         .FormatConditions(.FormatConditions.Count).SetFirstPriority
         With .FormatConditions(1).Interior
           .PatternColorIndex = xlAutomatic
           .Color = 13290186
           .TintAndShade = 0
         End With
         .FormatConditions(1).StopIfTrue = False
     End With

Wichtig ist, dass an den Stellen, wo vorher die Selection stand, jetzt nur noch der Punkt steht ...

[Ego]

Hallo Yvonne,

ich hatte zuerst deine Frage nicht verstanden, da ja das erste Makro genau deine Bedingungen erfüllt. (Aber wie ich jetzt gesehen habe in Fester Spaltenzuordnung).

Zum Testmakro:

Wenn du eine Bedingte Formatierung für jede Spalte neu erzeugst, ist diese auch nur für die jeweilige Spalte gültig.
Du kannst im Makro anhand der Überschriften zuerst in einer Variablen  zB strBereich die Bereiche eintragen. Hier "$J:$J,$L:$L" und dann -natürlich wie Ralf geschrieben hat ohne Selektion- die Formatierungen erzeugen:

With Range(strBereich)

...

[Kuwer]

Hallo Yvonne,

hier mein Vorschlag. Die Suche ist in eine separate Funktion ausgelagert und kann immer wieder verwendet werden. Bei erfolgreicher Suche werden alle Fundzellen per Union-Methode zusammengefasst und als Rangebereich zurückgegeben.

' **************************************************************
'  Modul:  ModulConditionalFormattingTest  Typ = Allgemeines Modul
' **************************************************************

Sub ConditionalFormatSheetX_Test()
 Dim rngB As Range, rngF As Range
 
 With Worksheets("X")
   .Cells.FormatConditions.Delete
   Set rngB = .Range(.Cells(6, 1), .Cells(6, .Columns.Count).End(xlToLeft))
 End With
 
 Set rngF = FindeZellen(rngB, "in %")
 If Not rngF Is Nothing Then
   With rngF.EntireColumn.FormatConditions.Add(Type:=xlCellValue, _
                                               Operator:=xlLess, _
                                               Formula1:="=-0,15")
     .SetFirstPriority
     With .Interior
       .PatternColorIndex = xlAutomatic
       .Color = 13290186
       .TintAndShade = 0
     End With
     .StopIfTrue = False
   End With
   
   With rngF.EntireColumn.FormatConditions.Add(Type:=xlCellValue, _
                                               Operator:=xlBetween, _
                                               Formula1:="=0,001", Formula2:="=0,5")
     .SetFirstPriority
     With .Interior
       .PatternColorIndex = xlAutomatic
       .Color = 10855845
       .TintAndShade = 0
     End With
     .StopIfTrue = False
   End With
   
   With rngF.EntireColumn.FormatConditions.Add(Type:=xlCellValue, _
                                               Operator:=xlBetween, _
                                               Formula1:="=0,5", Formula2:="=1000000")
     .SetFirstPriority
     With .Interior
       .PatternColorIndex = xlAutomatic
       .Color = 8421504
       .TintAndShade = 0
     End With
     .StopIfTrue = False
   End With
   Set rngF = Nothing
 End If  'Not rngF Is Nothing

 'weitere Suchen nach selbem Muster
 Set rngF = FindeZellen(rngB, "PLAN")
 If Not rngF Is Nothing Then
   'with ...
   '...
   'End With
   'Set rngF = Nothing
 End If  'Not rngF Is Nothing
 
End Sub

' **************************************************************
'  Modul:  f_FindeZellen  Typ = Allgemeines Modul
' **************************************************************

Option Explicit

Function FindeZellen(Suchbereich As Range, Suchtext As String) As Range
Dim rngB As Range
Dim rngGefundeneZellen As Range
Dim rngF As Range
Dim strErsteAdresse As String

 Set rngF = Suchbereich.Find(What:=Suchtext, _
                             LookIn:=xlValues, _
                             LookAt:=xlPart, _
                             SearchDirection:=xlNext, _
                             MatchCase:=False, _
                             SearchFormat:=False)
 If Not rngF Is Nothing Then
   strErsteAdresse = rngF.Address
   Set rngGefundeneZellen = rngF
   Do
     Set rngF = Suchbereich.FindNext(rngF)
     If Not rngF Is Nothing Then
       Set rngGefundeneZellen = Application.Union(rngF, rngGefundeneZellen)
     Else
       Exit Do
     End If
   Loop Until rngF.Address = strErsteAdresse
   Set FindeZellen = rngGefundeneZellen
 End If
End Function

Sub Test()
 Dim rngB As Range, rngF As Range
 With Worksheets("X")
   Set rngB = .Range(.Cells(6, 1), .Cells(6, .Columns.Count).End(xlToLeft))
 End With
 Set rngF = FindeZellen(rngB, "in %")
 If Not rngF Is Nothing Then
   Debug.Print rngF.EntireColumn.Address
 Else
   Debug.Print "Nichts gefunden"
 End If
End Sub

Code eingefügt mit: Excel Code Jeanie


Gruß Uwe

[Kuwer]

Hallo Yvonne,

die Funktion FindeZellen war noch nicht ganz fertig. Hier der fertige Code:

Modul f_FindeZellen

Option Explicit 

Function FindeZellen(Suchbereich As Range, Suchtext As String) As Range 
  Dim rngB As Range 
  Dim rngGefundeneZellen As Range 
  Dim rngF As Range 
  Dim strErsteAdresse As String 
  
  Set rngF = Suchbereich.Find(What:=Suchtext, _
                              LookIn:=xlValues, _
                              LookAt:=xlPart, _
                              SearchDirection:=xlNext, _
                              MatchCase:=False, _
                              SearchFormat:=False) 
  If Not rngF Is Nothing Then 
    strErsteAdresse = rngF.Address 
    Set rngGefundeneZellen = rngF 
    Do 
      Set rngF = Suchbereich.FindNext(rngF) 
      If Not rngF.Address = strErsteAdresse Then 
        Set rngGefundeneZellen = Application.Union(rngGefundeneZellen, rngF) 
      Else 
        Exit Do 
      End If 
    Loop 
    Set FindeZellen = rngGefundeneZellen 
  End If 
End Function 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Gruß Uwe

[Rabe]

Hi Yvonne,

Bin mir nicht sicher ob das Sinn macht, da in den entsprechenden Spalten auch oft neue Werte eingetragen werden.
Dann müsste jeder User das Makro nach Änderungen durchlaufen lassen, oder verstehe ich das falsch?

wenn die Zellen/Spalten, die geändert werden dürfen, überwacht werden, kann über das Worksheet_Change-Ereignis dann das Makro aufgerufen werden.
Also jedesmal, wenn in den entsprechenden Spalten was geändert wird, wird dann das Makro automatisch die Zellen einfärben.

[YvonneW]

Hallo liebe Excel-Spezialisten

Hat etwas gedauert da ich die letzten Wochen so im Stress war, so dass ich nicht mehr dazugekommen mir die Lösungen genau anzuschauen.
Erst mal vielen Dank an alle für Eure Unterstützung.

Die Lösung von Uwe hat mir am besten gefallen, da sie die Überschriften ausliest und dann in die Range packt.
Hierzu noch eine Frage:
Wie muss Set rngF = FindeZellen(rngB, "BW Order") geändert werden, damit nicht nur der String "BW Order" sondern auch die Strings "BW GR" und "SAVG" gefunden werden?

Eine Einfärbung der Zellen/Schriftfarbe ohne Conditional Format wie von Ralf vorgeschlagen ist mir zu restriktiv für die betreffenden Files, kann aber mal in Zukunft für eine interessante Option sein.

Merci

[Kuwer]

Hallo Yvonne,

Wie muss Set rngF = FindeZellen(rngB, "BW Order") geändert werden, damit nicht nur der String "BW Order" sondern auch die Strings "BW GR" und "SAVG" gefunden werden?

so wie ich es hier im Beitrag #6 schon schrieb.

Gruß Uwe