Format Biçim Rengine Göre Filtreleme

[baydeniro]

B sütununda soldan 3. harfi "Z" olanlar ile C sütununda 25 e eşit olanların koşullu biçimlendirmesini Kırmızı fona beyaz yazı yapıyor. Kırmızı fona beyaz yazı olanların filtrelenmesi sağlayan bir kod mümkün mü ? Örnek dosya ekte.

 

[Necdet]

Merhaba,

Koşullu Biçimlendirmedeki koşulun aynısını D sütununda yaparsanız, D sütununa göre süzme işlemini gerçekleştirebilirsiniz.

Koşulunuzdan her iki şartı sağlayan şeklinde anladım ve dosyadaki hem koşullu biçimlendirmeyi hemde yardımcı (D) sütunundaki formülü (ki Koşullu Biçimlendirme ile aynıdır) düzenledim.

D2:

=VE(PARÇAAL(B2;3;1)="z";C2=25)

 

[baydeniro]

Teşekkür ederim sayın Necdet Yeşertener. Acaba bu işlemi kod ile yapmanın olanağı var mıdır !!

 

[Necdet]

Merhaba,

D sütununu yine yardımcı sütun olarak kullandım ve Aşağıdaki formülü yazdırdım.

D2

=EĞER(VE(PARÇAAL(B2;3;1)="z";C2=25);1;"")

Makro :

Sub Suz()
    
    Dim i As Long
    On Error Resume Next
    
    Application.ScreenUpdating = False
    Range("A1").Activate
    If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter
    
    i = Cells(Rows.Count, "A").End(3).Row
    
    With Range("D2:D" & i)
        .FormulaR1C1 = "=IF(AND(MID(RC[-2],3,1)=""z"",RC[-1]=25),1,"""")"
        Selection.AutoFilter
        .AutoFilter Field:=4, Criteria1:=1
    End With
    
    Application.ScreenUpdating = True
    
End Sub

 

[baydeniro]

Çok teşekkür ederim Sayın Necdet Yeşertener.(çok çok özür diliyorum, lütfen mazur görün)

 

[Necdet]

Çok teşekkür ederim Sayın Necder Yeşertener.

Güle güle kullanınız Sayın Serdat Okan

 

[baydeniro]

.(çok çok özür diliyorum, lütfen mazur görün)

 

[Necdet]

.(çok çok özür diliyorum, lütfen mazur görün)

Özür dilemenize gerek yok Serdar bey, biraz muziplik olsun istedim.

Sadece bir şakaydı. Klavye hatası hep olmuştur olacaktırda.