VBA - makro na selekci datumu

[Metlic]

Dobrý den,

potřeboval bych VBA makro: označím x-buněk v sloupci, hodnoty jsou různé datumy (např.: formát 13.3.2014) od roku 2012-2015 - a z toho bych potřeboval označit všechny datumy z roku 2015 např. modře a všechny za rok 2014 např. červeně. Děkuji.

[Reklama]

[a.mlady]

Hezký den.
Musí to být přes makro, na to stačí podmíněný formát.

[Metlic]

děkuji za radu.

Bohužel asi musí, protože to potřebuji pro více souborů. Přes podmínečné formátování, bych to musel u každého souboru zvlášť nastavovat.

A navíc s jedním souborem pracuje více uživatelů, a ne všem moje nastavení může vyhovovat, takže proto potřebuji označit jen vybrané položky.

[Metlic]

Toto mi vyhodí, když použiji funkci záznam makra. Nefunguje ani když ho použiji na stejným listu, kde jsem ho vytvořil

ActiveSheet.Range("$A$1:$BM$9210").AutoFilter Field:=36, Operator:= _
xlFilterValues, Criteria2:=Array(0, "5/31/2015")
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveSheet.Range("$A$1:$BM$9210").AutoFilter Field:=36, Operator:= _
xlFilterValues, Criteria2:=Array(0, "12/31/2014")
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveSheet.Range("$A$1:$BM$9210").AutoFilter Field:=36
End Sub

[atari]

Tady máš kód. Je to holý kód bez ošetření chyb. Při výběru velké oblasti bude pomalý.

Kód: Vybrat vše

Sub BarevnyZapis()
Dim bunka As Range
Application.ScreenUpdating = False
For Each bunka In Selection
    If Year(bunka.Value) = 2015 Then bunka.Interior.Color = RGB(0, 0, 255)
    If Year(bunka.Value) = 2014 Then bunka.Interior.Color = RGB(255, 0, 0)
Next bunka
Application.ScreenUpdating = True
End Sub

--- Doplnění předchozího příspěvku (05 Čer 2015 08:33) ---

Tento kóD je asi o polovinu rychlejší. Pak se to dá ještě udělat ve stylu zde od eLCHa: viewtopic.php?f=35&t=154776, ale to neumím.

Kód: Vybrat vše

Sub BarevnyZapis2()
    Dim bunka As Range
    Application.ScreenUpdating = False
    For Each bunka In Selection
        Select Case Year(bunka.Value)
        Case 2015
        bunka.Interior.Color = RGB(0, 0, 255)
        Case 2014
        bunka.Interior.Color = RGB(255, 0, 0)
        End Select
    Next bunka
    Application.ScreenUpdating = True
    End Sub

[Metlic]

Děkuji vřele.