[chips]

Wiadomo, że formatowanie warunkowe jest ograniczone do 3 warunków.
Jak napisać kod by działał w ten sposób:

Jeżeli komórka A1>0 wtedy:
- cieniuj A1 na zielono
- pogrub czcionkę A1
- zmień czcionkę na kolor niebieski A1
- cieniuj cały wiersz1 na szaro
- zmień czcionkę w wierszu1 na italic
Jezeli A1<=0 wtedy:
- cieniuj A1 na czerwono
- pogrub czcionkę A1
- zmień czcionkę na kolor biały A1
- cieniuj cały wiersz1 na żółto
- zmień czcionkę w wierszu1 na podkreśloną

Z góry dzięki.

[Rycho]

Witam.
Nie sądzę, by w tym przypadku potrzebne było makro, gdyż masz jedynie dwa warunki.
Oczywiście osobno należy ustawić formatowanie warunkowe dla komórek w kolumnie A
'wartość komórki jest' 'większa niż' '0'
i osobno dla reszty komórek ale dla wiersza w zależności od komórki A1
'formuła jest': =($A1>0)
lub
'formuła jest': =($A1<=0)

lub takie makro:

Kod:

Sub koloruj()   Dim kom As Range     Application.EnableEvents = False   Application.ScreenUpdating = False     For Each kom In Intersect(ActiveSheet.UsedRange, Columns("A"))     With kom       If .Value > 0 Then         .Interior.ColorIndex = 35         .Font.ColorIndex = 5         .Font.Bold = True         With Rows(.Row)           .Interior.ColorIndex = 15           .Font.Underline = xlUnderlineStyleNone           .Font.Italic = True         End With       Else         .Interior.ColorIndex = 3         .Font.ColorIndex = 5         .Font.Bold = True         With Rows(.Row)           .Interior.ColorIndex = 36           .Font.Underline = xlUnderlineStyleSingle           .Font.Italic = False         End With       End If     End With   Next     Application.ScreenUpdating = True   Application.EnableEvents = True End Sub

Pozdrawiam

[chips]

Wielkie dzieki. W tym przykładzie podałem tylko niezbedne dane aby nie zagmatwać problemu. W rzeczywistości formatowanie warunkowe jest wykorzystane Jeszcze raz - Dzięki.

[chips]

Kurcze nie działa. Jeżeli zmienie wartość w A1 nic nie się nie zmienia. Rycho sprawdzałeś to makro u siebie?

[Trebor]

Będzie działać pod warunkiem, że go (makro) uruchomisz ręcznie, przyciskiem, skrótem itp.
Nie odpali się z automatu.

[chips]

A co zrobić żeby działało z automatu?

[Rycho]

Hej.
Możesz dodatkowo w module arkusza (nie module ogólnym) wstawić takie makro uruchamiające procedurę 'koloruj' po zmianie w kolumnie A:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)   If Not Intersect(Target, Columns("A")) Is Nothing Then     Call koloruj   End If End Sub

Pozdrawiam

[chips]

Dzięki. Kod jednak powodował że:
1. Jeżeli opuściłem jakieś wiersz zaznaczał go na zółto.
2. Formatowanie wiersza było nadzrzedne dla formatowania komórki.

Trochę więc zmienilem twój kod i chyba działa:

Kod:

Sub koloruj()   Dim kom As Range     Application.EnableEvents = False   Application.ScreenUpdating = False     For Each kom In Intersect(ActiveSheet.UsedRange, Columns("A"))     With kom       If .Value > 0 Then         With Rows(.Row)           .Interior.ColorIndex = 15           .Font.Underline = xlUnderlineStyleNone           .Font.Italic = True         End With         .Interior.ColorIndex = 35         .Font.ColorIndex = 5         .Font.Bold = True      End If      If .Value < 0 Then        With Rows(.Row)           .Interior.ColorIndex = 36           .Font.Underline = xlUnderlineStyleSingle           .Font.Italic = False         End With         .Interior.ColorIndex = 3         .Font.ColorIndex = 5         .Font.Bold = True     End If          End With   Next     Application.ScreenUpdating = True   Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range)   If Not Intersect(Target, Columns("A")) Is Nothing Then     Call koloruj   End If End Sub

[chips]

Kurcze a jak zmienić sprawdzany warunek

Kod:

If .Value > 0 Then

Na

Kod:

[Wartość komórki] - [Dzisiejsza data] < 30

[Trebor]

"Dzisiejsza data" w VBA to Date
Pozdrawiam

[chips]

Co tu niegra? Type mismatch

Kod:

Sub dataauditu()   Dim kom As Range     Application.EnableEvents = False   Application.ScreenUpdating = False     For Each kom In Intersect(ActiveSheet.UsedRange, Columns("E"))     With kom       If .Value - Date < 30 Then         .Interior.ColorIndex = 35         .Font.ColorIndex = 5         .Font.Bold = True      End If     End With   Next     Application.ScreenUpdating = True   Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range)   If Not Intersect(Target, Columns("E")) Is Nothing Then     Call dataauditu   End If End Sub

[Trebor]

Być może w kolumnie jest coś co nie jest datą. Aby przeskoczyć taki błąd możesz zrobić tak:

Kod:

For Each kom In Intersect(ActiveSheet.UsedRange, Columns("E"))     With kom     If IsDate(.Value) Then       If .Value - Date < 30 Then         .Interior.ColorIndex = 35         .Font.ColorIndex = 5         .Font.Bold = True      End If      End If     End With   Next

[chips]

Domyślam się, że twoja linia kodu sprawdza czy komórka jest datą. Gdy ją wstawiłem makro nic nie robi. Tak jakby wartość w kolumnie E nie była datą. A jest w formacie rrrr-mm-dd. Może to problem z deklaracjami zmiennych na poczatku kodu tzn. tą date trzeba jakoś zadeklarować (strzelam )

[Tajan]

A czy wartość komórki po zmianie formatu na "Ogólny" zmienia się w liczbę? Pamiętaj, że czasem nie wystarczy sama zmiana formatu do tego, aby wartość była traktowana przez Excela jak data. Możesz tez spróbować zmienić kod makra z:

Kod:

If IsDate(.Value) Then

na:

Kod:

If IsNumeric(.Value) Then

[chips]

hmm, Otworzyłem dziś arkusz, stanąłem na końcu jednej z dat w kolumnie E i nacisnąłem ENTER i zakolorowało mi zgodnie z danymi w kodzie wszystkie daty w kolumnie E.
Więc niby działa. Tylko coś nie tak jest z warunkiem:

Kod:

If .Value - Date < 30 Then

bo nawet jezeli Data w komórce - Data dzisiejsza = 60 to zabarwia komórkę tak jak inne komórki. Generalnie jeżeli w komórce jest data (nieważne jaka) to formatuje ją wg paramterów podanych w kodzie.
P.S. Narazie nie zmieniałem kodu na:

Kod:

If IsNumeric(.Value) Then