Thema Datum  Von Nutzer Rating
Antwort
13.03.2014 16:40:14 Fritz Hammann
NotSolved
14.03.2014 07:55:19 Fritz Hammann
NotSolved
Rot Bedingtes Formatieren mit Macro
14.03.2014 18:19:12 H27
NotSolved

Ansicht des Beitrags:
Von:
H27
Datum:
14.03.2014 18:19:12
Views:
715
Rating: Antwort:
  Ja
Thema:
Bedingtes Formatieren mit Macro

Hi Fritz,

nette Finderübung

Sub BedingtesFormatierenMitMacroErstellen()
Rem *******************************************
Rem statt For Next über Rangeobjekte definieren
Rem *******************************************

Rem Festlegungen  für variable Verwendung
Const begRow As Long = 2      'Beginne ab Zeile 2

Const fstCol As Long = 1      'Erste Spalte wo formatiert [A:A]
Const nxtCol As Long = 3      'Anzahl Spalten daneben somit [D:D]

Const Muster As String = "=ANZAHL2($E$1:$U$1) = 0"   'Musterformel

Rem die Spalten dazu nach der Musterformel
Const fraCol As Long = 4      'Anzahl Spalten daneben wo Formelbereich beginnt [E:E]
Const freCol As Long = 20     'Anzahl Spalten daneben wo Formelbereich zu Ende [U:U]

Rem die Farbe - hier Gelb
Const mRed As Integer = 255
Const mGre As Integer = 255
Const mBlu As Integer = 0

Rem die Variablen
Dim aRng As Range   'Tabelle durchlaufen
Dim bRng As Range   'Bereich wo bedingt formatiert
Dim vRng As Range   'Bereich wo Formel für

Dim c As Range      'aktueller Bereich
Dim fStr As String  'für Musterformel
Dim lstRow As Long  'bis letzte Zeile
Dim IntCol As Long  'Farbwert

  Rem vorhandene Formatierungen löschen
  Cells.FormatConditions.Delete
  
  Rem von begRow bis lstRow
  lstRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
  Rem Spalte A von [A2] nach unten
  Set aRng = Range(Cells(begRow, fstCol), Cells(lstRow, fstCol))
  
  Rem Farbwert
  IntCol = RGB(mRed, mGre, mBlu)
  
  Rem jetzt ab nach unten
  For Each c In aRng
        
    Rem Bereich für die Formel in der Zeile
    Set vRng = Range(c.Offset(0, fraCol), c.Offset(0, freCol))
    
    Rem Bereich wo bedingt formatiert
    Set bRng = Range(c, c.Offset(0, nxtCol))
    
    Rem Musterformel in Variable
    fStr = Muster
    Rem Austausch mit akt. Wert
    fStr = Replace(fStr, "$E$1:$U$1", vRng.Address)
    
    Rem Bereich wo bedingt formatiert versorgen
    bRng.FormatConditions.Add Type:=xlExpression, Formula1:=fStr
    bRng.FormatConditions(bRng.FormatConditions.Count).SetFirstPriority
    With bRng.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = IntCol
        .TintAndShade = 0
    End With
    bRng.FormatConditions(1).StopIfTrue = True  'Standard
  Next c
  
Rem Fertig
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
13.03.2014 16:40:14 Fritz Hammann
NotSolved
14.03.2014 07:55:19 Fritz Hammann
NotSolved
Rot Bedingtes Formatieren mit Macro
14.03.2014 18:19:12 H27
NotSolved