Podmíněné formátování jinak - Excel Vyřešeno

[hugo.]

Existuje v Excelu nějaká možnost jak podbarvit řádek nebo měnit barvu textu v řádku v závislosti na určité buňce (nejedná se o podbarvení jedné buňky -> lze vyřešit podmíněným formátováním). Např. v buňce D3 mám obsah "A". Při změně na "N" bych chtěl vidět celý řádek 3 podbarvený, popř. v celém řádku písmo jinou barvou. Dík

[Reklama]

[Pavel123]

No jedině mě napadá makro (událostní procedura)

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("D3").Value = "N" Then
        Rows("3:3").Interior.ColorIndex = 3
    Else
        Rows("3:3").Interior.ColorIndex = xlNone
    End If
End Sub


[Ltb]

Souhlas s Pavlem, ideálním řešením je napsat nějaké jednoduché udělátko ve VBA. Další (možná jednodušší) variantou by bylo použít Podmíněné formátování za použití vzorce (překliknout vlevo z Hodnoty buňky na vzorec)

[CZMiki]

Ahoj, je mi jasné, že tohle téma je staré, ale proč zakládat nová, když se to sem hodí... :)

Potřebuju poradit s podmíněným formátováním ve VBA pomocí vzorce. Mám více souborů o dvou listech, které každý týden aktualizuji a potřebuji je trochu "graficky" upravit. Hlavičky a úpravu šířky sloupců mám, ale potřebuji, aby se na základě datumu(v na prvním listu je ve sloupci G, na druhém ve sloupci E) zabarvilo písmo celého řádku červeně.

Bez VBA to zvládám pomocí tohoto vzorce (pořebuji označit vše starší jednoho měsíce) =DATEDIF($G1;DNES();"M")>=1

Dosavadní stav makra:

Kód: Vybrat vše

Sub Chybovky_podbarveni()
'
' Chybovky_podbarveni Makro
'

'
    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
   
    ActiveSheet.Next.Select
   
    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    Range("A1").Select
    ActiveSheet.Previous.Select
    Range("A1").Select
    ActiveWorkbook.Save
End Sub

¨
Najde se nějaká dobrá duše?

[Azuzula]

Trochu (víc) nechápu co vlastně potřebuješ když máš makro i vzorec pro podmíněné formátování.
Upřesni co vlastně chceš.

[CZMiki]

No, potřebuju to zaimplementovat do toho makra :) Asi to bude triviální, ale v makrech jsem naprostý mimoň, jsou pro mne jen shlukem nicneříkajících písmen. Tohle makro jsem nahrál přes záznam makra, jen jsem v něm upravil next a pravious sheet za pevné názvy, protože jsou promnělivé. Bohužel ničeho jiného nejsem ve VBA schopen :/

[Azuzula]

Aha, jednodušší asi bude použít podmíněné formátování označ si řádek/oblast buněk kde chceš formátovat a do vzorce podmíněného formátování zapiš =$G1<=DNES()-30
A tlačítkem formát si nastav jak chceš aby se to zvýraznilo.
Tenhle vzorec pak označí datumy co budou starší 30ti dnů pokud je to tak OK.

[CZMiki]

Asi si nerozumíme :) V klasickém podmíněném formátování to zvládám (viz ten vzorec), ale já bych to rád provedl pomocí makra (něco, ve smyslu úvodního postu).
...generuji takových souborů cca 20 a každý nastavovat ručně je na pytel.

[Azuzula]

Tak použijte toto makro

Kód: Vybrat vše

Sub oznac()
Dim i As Double, j As Double
Dim datum As Date

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Rows(i & ":" & i).Select 'označí komplet celý řádek
    Cells(i, 7).Activate 'číslo sloupku kde je datum
    datum = Day(Now) & "." & Month(Now) - 1 & "." & Year(Now)
    If ActiveCell <= datum And ActiveCell <> "" Then
        Selection.Font.Bold = True
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.149998474074526
            .PatternTintAndShade = 0
        End With
    End If
Next i
ActiveSheet.Next.Select
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    Rows(i & ":" & i).Select 'označí komplet celý řádek
    Cells(i, 5).Activate 'číslo sloupku kde je datum
    datum = Day(Now) & "." & Month(Now) - 1 & "." & Year(Now)
    If ActiveCell <= datum And ActiveCell <> "" Then
        Selection.Font.Bold = True
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.149998474074526
            .PatternTintAndShade = 0
        End With
    End If
Next i
ActiveSheet.Previous.Select
End Sub


Nebo by se dalo zjednodušit na polovinu s jednou pomocnou buňkou v listu, kde by bylo číslo sloupku s datem.

[CZMiki]

Moc děkuju, jde to správným směrem!
Jestli mohu požádat ještě o doladění, bylo by to skvělé, opravdu si s tím bohužel sám neporadím.
To vaše makro sice vybere správná data, ale to označení bych potřeboval jinak. Komplet nechat funkční ten můj úvodní kód (roztáhne sloupce a upraví písmo a pozadí záhlaví - to je OK, ale jinam, než do záhlaví to nepatří) a přidat k němu, aby se podle datumu zabarvily řádky, respektive pouze jejich písmo červeně (pozadí nechat).

Předem moc děkuji za pomoc a trpělivost

[Azuzula]

Na obarvení řádků jsem použila váš vzor z prvního makra, šedá buňka a písmo tučně. Na autofit jsem zapoměla, doplním ho tam.
Můžete do přílohy přidat nějaký demo soubor? Bude to pak lepší ať mám na čem testovat.

[CZMiki]

Určitě, přikládám vzorek před a jak by to mělo vypadat po. Musel jsem odstranit nějaká důvěrná data a taky jsem odmazal pár sloupců, aby se zmenšila velikost, ale všechny sloupce před datumem a nějaké za jsem nechal. Jen připomínám, že vše, kromě rozložení sloupců a záhlaví se mění (název souboru, názvy dvou listů, data...)