Seçilen Ay'a Göre Süzme

[sekozzy]

Merhaba arkadaşlar, ekteki örnek dosyaya göre Sayfa1'de seçilen aya göre Sayfa2 ve Sayfa3'teki veriler süzülsün istiyorum. Konu hakkında yardımcı olursanız memnun olurum.
Dosya Linki: https://yadi.sk/i/_LGYmhdiMghvBQ

 

[hamitcan]

Öncelikle tüm OptionButton nesnelerini [a1] hücresine bağlayın.
ThisWorkBook kısmına ekleyin.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Filtrele
End Sub

Bir Module içine ekleyin.

Sub Filtrele()
    Dim StartDate As Date
    Dim EndDate As Date
    StartDate = DateSerial(2019, Sheets("Sayfa1").[a1], 1)
    EndDate = DateSerial(2019, Sheets("Sayfa1").[a1] + 1, 0)

    Sheets("Sayfa2").Range("$B$3:$B$1000").AutoFilter Field:=1, Criteria1:=">=" & CDbl(StartDate), Operator:=xlAnd, Criteria2:="<=" & CDbl(EndDate)
    Sheets("Sayfa3").Range("$B$3:$B$1000").AutoFilter Field:=1, Criteria1:=">=" & CDbl(StartDate), Operator:=xlAnd, Criteria2:="<=" & CDbl(EndDate)
End Sub

 

[sekozzy]

Hamitcan bey cevabınız için teşekkür ederim. Ay başlangıcından 1 gün öncesi ve ay bitiminden 1 gün sonrasıyla birlikte süzmek için kodu nasıl revize etmeliyim. Örneğin Şubat ayını seçtiğimde 31.01.2019 - 01.03.2019 aralığını süzmesi için...

Ben şu şekilde denediğimde oluyor fakat her sayfa için bunu tek tek yapmam gerekiyor.

    Sheets("Sayfa2").Range("$B$3:$B$1000").AutoFilter Field:=1, Criteria1:=">=" & CDbl(StartDate) - 1, Operator:=xlAnd, Criteria2:="<=" & CDbl(EndDate) + 1

Çok fazla sayfası olan bir dosya için bundan daha pratik bir yöntem mümkün mü? Yoksa bu şekilde kullanmaya devam mı etmeliyim?

 

[sekozzy]

cevabı tekrar düzenleyemediğim için yeni cevap yazmak zorunda kaldım kusura bakmayın.

Hamitcan bey ayrıca süzme işlemi sonunda TOPLAM satırı kalacak şekilde süzme işlemini düzenleyemedim. Bu konuda da yardımcı olursanız memnun olurum.

 

[hamitcan]

Sheets("Sayfa2")
Sheets("Sayfa3")

yerine,

ActiveSheet

kullanarak dener misiniz ?

 

[hamitcan]

ThisWorkBook kısmındaki kodu aşağıdaki şekilde değiştirin.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = "Sayfa1" Then Exit Sub
    Filtrele
End Sub

 

[sekozzy]

cevabı tekrar düzenleyemediğim için yeni cevap yazmak zorunda kaldım kusura bakmayın.

Hamitcan bey ayrıca süzme işlemi sonunda TOPLAM satırı kalacak şekilde süzme işlemini düzenleyemedim. Bu konuda da yardımcı olursanız memnun olurum.

Hamitcan bey son olarak şu kısmı yapamadım. Bu konuyu da çözersek sorunum çözülmüş olacak. Teşekkürler.

 

[hamitcan]

Toplam satırı için kodu revize ettim.

Sub Filtrele()
    Dim StartDate As Date
    Dim EndDate As Date
    StartDate = DateSerial(2019, Sheets("Sayfa1").[a1], 1)
    EndDate = DateSerial(2019, Sheets("Sayfa1").[a1] + 1, 0)
    x = [b65536].End(3).Row + 1
    
    ActiveSheet.Range("$B$3:$B$" & x - 1).AutoFilter Field:=1, Criteria1:=">=" & CDbl(StartDate), Operator:=xlAnd, Criteria2:="<=" & CDbl(EndDate)

   
    For i = 3 To 16
    Cells(x, i) = WorksheetFunction.Sum(Range(Cells(3, i), Cells(x - 1, i)))
    Next
End Sub

 

[sekozzy]

Toplam satırı için kodu revize ettim.

Sub Filtrele()
    Dim StartDate As Date
    Dim EndDate As Date
    StartDate = DateSerial(2019, Sheets("Sayfa1").[a1], 1)
    EndDate = DateSerial(2019, Sheets("Sayfa1").[a1] + 1, 0)
    x = [b65536].End(3).Row + 1
   
    ActiveSheet.Range("$B$3:$B$" & x - 1).AutoFilter Field:=1, Criteria1:=">=" & CDbl(StartDate), Operator:=xlAnd, Criteria2:="<=" & CDbl(EndDate)

  
    For i = 3 To 16
    Cells(x, i) = WorksheetFunction.Sum(Range(Cells(3, i), Cells(x - 1, i)))
    Next
End Sub

Hamitcan bey toplam satırında sadece toplam değil ortalama, dolu_saydırma, eşitse saydırma gibi bir çok farklı formüller kullanacağım, sadece toplama işlemi değil. O yüzden ben sadece o satırın filtrelemeden bağımsız kalması mümkün müdür diye sormuştum. Sanırım filtreleme yaparken bu mümkün değil. Bu nedenle vazgeçtim. Soruma verdiğiniz yanıtlardan ötürü ve ayrıca ayırmış olduğunuz zaman için çok teşekkür ederim. Hayırlı işler, kolay gelsin.