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

[MESUT K]

Aylara hızlı geçiş yaptığımda sıralı olmadan farklı aylara geçiş yaptığımda şu şekilde hata veriyor.Normalde kod çalışıyor

 

[ÖmerFaruk]

Merhaba,
G1 için yaptığınız veri doğrulamayı aşağıdaki gibi düzeltin.
Resimde görüldüğü gibi Liste seçiminden sonra Kaynak kısmına aşağıdakini yazın

Tüm Aylar;Ocak;Şubat;Mart;Nisan;Mayıs;Haziran;Temmuz;Ağustos;Eylül;Ekim;Kasım;Aralık



Kullandığınız kodları da aşğıdakiyle değiştirin.

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)
        If [G1] = "Tüm Aylar" Then Alan.AutoFilter: Set Sh = Nothing: Set Alan = Nothing: Exit Sub
        Tarih1 = DateSerial(Range("D1"), 1, 1)
        Do
            If Format(Tarih1, "mmmm") = Sh.Range("G1") 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

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ay As Variant, Tarih As Date
    On Error GoTo 10
    Ay = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
    Tarih = DateSerial(Range("D1"), WorksheetFunction.Match(Range("G1"), Ay, 0), 1)
    Range("B2:B" & Rows.Count).AutoFilter 1, ">=" & CLng(Tarih), xlAnd, "<=" & CLng(WorksheetFunction.EoMonth(Tarih, 0))
    Exit Sub
10  If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.ShowAllData
End Sub

 

[MESUT K]

Merhaba,
G1 için yaptığınız veri doğrulamayı aşağıdaki gibi düzeltin.
Resimde görüldüğü gibi Liste seçiminden sonra Kaynak kısmına aşağıdakini yazın

Tüm Aylar;Ocak;Şubat;Mart;Nisan;Mayıs;Haziran;Temmuz;Ağustos;Eylül;Ekim;Kasım;Aralık

Ekli dosyayı görüntüle 231313

Kullandığınız kodları da aşğıdakiyle değiştirin.

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)
        If [G1] = "Tüm Aylar" Then Alan.AutoFilter: Set Sh = Nothing: Set Alan = Nothing: Exit Sub
        Tarih1 = DateSerial(Range("D1"), 1, 1)
        Do
            If Format(Tarih1, "mmmm") = Sh.Range("G1") 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 Bey ,denedim bu şekilde sıkıntısız çalışıyor emekleriniz için çok teşekkür ederim.Saygılarımla

 

[MESUT K]

Alternatif;

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ay As Variant, Tarih As Date
    On Error GoTo 10
    Ay = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
    Tarih = DateSerial(Range("D1"), WorksheetFunction.Match(Range("G1"), Ay, 0), 1)
    Range("B2:B" & Rows.Count).AutoFilter 1, ">=" & CLng(Tarih), xlAnd, "<=" & CLng(WorksheetFunction.EoMonth(Tarih, 0))
    Exit Sub
10  If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.ShowAllData
End Sub

Çok teşekkürler Korhan Ayhan Bey,Sizin verdiğiniz alternatif kodda sorunsuz çalışıyor