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