Soru AY SEÇEREK ,TARİH ARALIĞI FİLTRELEME

[MESUT K]

Herkese merhaba

Sorunumla ilgili site içerisinde benzer konu buldum fakat bulduğum konu üzerinden çözüme ulaşamadım.Özel filtre kısmınıda denedim o da işimi görmedi.

Dosya içerisinde sorunumu detaylı olarak gösterdim.Bilen üstadlarımdan yardım istiyorum.Saygılarımla

İndir FİLTRE

Dosyayı indir FİLTRE

dosya.co

 

[Merhum İdris SERDAR]

.

Buradaki dosyayı inceleyin.

.

 

[ÖmerFaruk]

Dosyanızda çalıştırmıştım. Cevap gelmiş ama yine de paylaşayım.

Sub Filtrele()
    Dim Alan As Range, Tarih1 As Date, Tarih2 As Date, Sh As Worksheet
    Set Sh = Worksheets("Sayfa1")
    With Sh
        Set Alan = Sh.Range("B2:B" & Sh.Range("B" & Rows.Count).End(3).Row)
        Tarih1 = DateSerial(Range("D1"), 1, 1)
        Do
            If Format(Tarih1, "mmmm") = Replace(StrConv(Sh.Range("G1"), vbProperCase), "İ", "i") Then Exit Do
            Tarih1 = DateAdd("m", 1, Tarih1)
        Loop
        Tarih2 = DateAdd("m", 1, Tarih1) - 1
        Alan.AutoFilter Field:=1, Criteria1:=">=" & CDbl(Tarih1), Operator:=xlAnd, Criteria2:="<=" & CDbl(Tarih2)
    End With
    Set Sh = Nothing: Set Alan = Nothing
End Sub

 

[MESUT K]

.

Buradaki dosyayı inceleyin.

.

İdris Serdar Bey dosya içeriği çok iyi fakat bunu el ile yazılan tarihleri süzmede işimi görmeyecek gibi

 

[MESUT K]

Dosyanızda çalıştırmıştım. Cevap gelmiş ama yine de paylaşayım.

Sub Filtrele()
    Dim Alan As Range, Tarih1 As Date, Tarih2 As Date, Sh As Worksheet
    Set Sh = Worksheets("Sayfa1")
    With Sh
        Set Alan = Sh.Range("B2:B" & Sh.Range("B" & Rows.Count).End(3).Row)
        Tarih1 = DateSerial(Range("D1"), 1, 1)
        Do
            If Format(Tarih1, "mmmm") = Replace(StrConv(Sh.Range("G1"), vbProperCase), "İ", "i") Then Exit Do
            Tarih1 = DateAdd("m", 1, Tarih1)
        Loop
        Tarih2 = DateAdd("m", 1, Tarih1) - 1
        Alan.AutoFilter Field:=1, Criteria1:=">=" & CDbl(Tarih1), Operator:=xlAnd, Criteria2:="<=" & CDbl(Tarih2)
    End With
    Set Sh = Nothing: Set Alan = Nothing
End Sub

Ömer faruk bey g1 hücresindeki açılır listede bu kodun çalışması için nasıl uygulayabilirim

 

[ÖmerFaruk]

Zaten G1 hücresndeki AY adına bakıyor. Sizin kastınız başka bir şey mi?

 

[MESUT K]

Ömer faruk bey g1 hücresindeki açılır listede bu kodun çalışması için nasıl uygulayabilirim

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Alan As Range, Tarih1 As Date, Tarih2 As Date, Sh As Worksheet
    Set Sh = Worksheets("Sayfa1")
    With Sh
        Set Alan = Sh.Range("B2:B" & Sh.Range("B" & Rows.Count).End(3).Row)
        Tarih1 = DateSerial(Range("D1"), 1, 1)
        Do
            If Format(Tarih1, "mmmm") = Replace(StrConv(Sh.Range("G1"), vbProperCase), "İ", "i") Then Exit Do
            Tarih1 = DateAdd("m", 1, Tarih1)
        Loop
        Tarih2 = DateAdd("m", 1, Tarih1) - 1
        Alan.AutoFilter Field:=1, Criteria1:=">=" & CDbl(Tarih1), Operator:=xlAnd, Criteria2:="<=" & CDbl(Tarih2)
    End With
    Set Sh = Nothing: Set Alan = Nothing
End Sub

bu şekilde sayfaya uyguladım fakat çalışmadı

 

[Merhum İdris SERDAR]

İdris Serdar Bey dosya içeriği çok iyi fakat bunu el ile yazılan tarihleri süzmede işimi görmeyecek gibi

İlk mesajında dosyada detaylı gösterdim demişsiniz. Ben Detay bir şey göremedim. Filtreleyecek derken nasıl? Bir örnek verir misiniz?

.

 

[ÖmerFaruk]

G1 hücresi değişince kodlar da çalışsın istiyorsanız aşağıdaki gibi kullanın

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [G1]) Is Nothing Then Exit Sub
    Dim Alan As Range, Tarih1 As Date, Tarih2 As Date, Sh As Worksheet
    Set Sh = Worksheets("Sayfa1")
    With Sh
        Set Alan = Sh.Range("B2:B" & Sh.Range("B" & Rows.Count).End(3).Row)
        Tarih1 = DateSerial(Range("D1"), 1, 1)
        Do
            If Format(Tarih1, "mmmm") = Replace(StrConv(Sh.Range("G1"), vbProperCase), "İ", "i") Then Exit Do
            Tarih1 = DateAdd("m", 1, Tarih1)
        Loop
        Tarih2 = DateAdd("m", 1, Tarih1) - 1
        Alan.AutoFilter Field:=1, Criteria1:=">=" & CDbl(Tarih1), Operator:=xlAnd, Criteria2:="<=" & CDbl(Tarih2)
    End With
    Set Sh = Nothing: Set Alan = Nothing
End Sub

 

[MESUT K]

G1 hücresi değişince kodlar da çalışsın istiyorsanız aşağıdaki gibi kullanın

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [G1]) Is Nothing Then Exit Sub
    Dim Alan As Range, Tarih1 As Date, Tarih2 As Date, Sh As Worksheet
    Set Sh = Worksheets("Sayfa1")
    With Sh
        Set Alan = Sh.Range("B2:B" & Sh.Range("B" & Rows.Count).End(3).Row)
        Tarih1 = DateSerial(Range("D1"), 1, 1)
        Do
            If Format(Tarih1, "mmmm") = Replace(StrConv(Sh.Range("G1"), vbProperCase), "İ", "i") Then Exit Do
            Tarih1 = DateAdd("m", 1, Tarih1)
        Loop
        Tarih2 = DateAdd("m", 1, Tarih1) - 1
        Alan.AutoFilter Field:=1, Criteria1:=">=" & CDbl(Tarih1), Operator:=xlAnd, Criteria2:="<=" & CDbl(Tarih2)
    End With
    Set Sh = Nothing: Set Alan = Nothing
End Sub

Ömer Faruk Bey bu şekilde tam istediğim gibi oldu çok teşekkür ederim

 

[MESUT K]

Ömer Faruk Bey benim ekte verdiğim dosyada verdiğiniz kodlar çok düzgün çalışıyor.Verdiğiniz kodu esas kullanmak istediğim dosyaya uyarladığım zaman bu şekilde hata alıyorum.Ekte verdiğim dosya ile esas uygulamak istedğim dosya arasında çok bir fark yok.

 

[MESUT K]

Set Sh = Worksheets("RAPOR NO") şeklinde değiştirince kod çalıştı.Fakat şimdide herhangi bir ayı seçtiğimde komple tarihleri gizliyor

 

[ÖmerFaruk]

Tarih1 yazan satırı aşağıdaki gibi değiştirin.
Yıl öncekin dosyanızda D1 deydi yeni dosyanızda A1 de ise D1 yazan kısmı A1 yaparsınız)
Tarih1 = DateSerial(Sh.Range("D1"), 1, 1)

 

[MESUT K]

tarih kısmını düzelttim .Kod şuan hata vermiyor fakat şimdide tarih 2021 olarak seçili olduğu halde ama 2000 li yılları süzmeye çalışıyor.
Birde "BÜTÜN AYLAR" yazdığımda komple süzdürmenin kalkmasını sağlayabilirmiyiz

 

[MESUT K]

Kodda sıkıntı kalmadı şuan.

Sadece "BÜTÜN AYLAR" yazdığımda komple süzdürmenin kalkmasını sağlayabilirmiyiz

 

[ÖmerFaruk]

Bütün Aylar yine G1 de yazacaksa, aşağıdaki gibi Set Alan=..... satırının altına verdiğim IF ile başlayan satırı ilave edin

Set Alan = Sh.Range("B2:B" & Sh.Range("B" & Rows.Count).End(3).Row)
        If [G1] = "Bütün Aylar" Then Alan.AutoFilter: Set Sh = Nothing: Set Alan = Nothing: Exit Sub

Not: Bütün Aylar yerine BÜTÜN AYLAR kullanıyorsanız doğru sonuç vermez. Birinden birini değiştirsiniz.

 

[MESUT K]

Dediğiniz şekilde uyguladım benim için sakıncası yok.Bu şekilde hata gösterdi

 

[ÖmerFaruk]

Dosyanızı son haliyle paylaşırmısın.
Do öncesindeki Tarih satırı hata vermemişse bu satırın da hata vermemesi gerekir.

 

[MESUT K]

ay geçişleri yaparkende bu hatayı verebiliyor.Dosyanın son hali ektedir

 

[ÖmerFaruk]

Dosyayı açtım, kodlar hata vermeden çalışıyor, filtreliyor, ay geçişlerinde de hata vermeden doğru sonucu döndürüyor.