• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan MESUT K
  • Başlangıç tarihi Başlangıç tarihi
M

MESUT K

Katılım
26 Nisan 2019
Mesajlar
221
Excel Vers. ve Dili
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
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
 

Ekli dosyalar

Dosyanızda çalıştırmıştım. Cevap gelmiş ama yine de paylaşayım.
C++: 
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
 
ÖmerFaruk' Alıntı:
Dosyanızda çalıştırmıştım. Cevap gelmiş ama yine de paylaşayım.
C++: 
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
Genişletmek için tıkla ...
Ömer faruk bey g1 hücresindeki açılır listede bu kodun çalışması için nasıl uygulayabilirim
 
Zaten G1 hücresndeki AY adına bakıyor. Sizin kastınız başka bir şey mi?
 
MESUT K' Alıntı:
Ömer faruk bey g1 hücresindeki açılır listede bu kodun çalışması için nasıl uygulayabilirim
Genişletmek için tıkla ...

Kod: 
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ı
 
MESUT K' Alıntı:
İdris Serdar Bey dosya içeriği çok iyi fakat bunu el ile yazılan tarihleri süzmede işimi görmeyecek gibi
Genişletmek için tıkla ...


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

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

C++: 
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
 
ÖmerFaruk' Alıntı:
G1 hücresi değişince kodlar da çalışsın istiyorsanız aşağıdaki gibi kullanın

C++: 
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
Genişletmek için tıkla ...
Ömer Faruk Bey bu şekilde tam istediğim gibi oldu çok teşekkür ederim
 
231301

Ö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.
 
Set Sh = Worksheets("RAPOR NO") şeklinde değiştirince kod çalıştı.Fakat şimdide herhangi bir ayı seçtiğimde komple tarihleri gizliyor
 
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)
 
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

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

Sadece "BÜTÜN AYLAR" yazdığımda komple süzdürmenin kalkmasını sağlayabilirmiyiz
 
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
C++: 
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.
 
Dediğiniz şekilde uyguladım benim için sakıncası yok.Bu şekilde hata gösterdi
231304
 
Dosyanızı son haliyle paylaşırmısın.
Do öncesindeki Tarih satırı hata vermemişse bu satırın da hata vermemesi gerekir.
 
ay geçişleri yaparkende bu hatayı verebiliyor.Dosyanın son hali ektedir
 

Ekli dosyalar

Dosyayı açtım, kodlar hata vermeden çalışıyor, filtreliyor, ay geçişlerinde de hata vermeden doğru sonucu döndürüyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst