iki tarih arası süzme işlemi hakkında yardımcı olabilir misiniz

[manisalı88]

Öncelikle merhaba sayın arkadaşlar. Ben excelde iki tarih arası süzme işlemini birtürlü yapamadım. Ekte gönderdiğim excelde bir liste var ve ben bu listeyi fiili tarihi baz alarak iki tarih arasındakileri süzdürerek Sayfa2 ye kopyalamasını istiyorum. Ama Sayfa1 deki listeyi bozmayarak. Bunu çok uğraştım ama bir türlü başaramadım. Bana yardımcı olursanız çok sevinirim.
Ekli dosyayı görüntüle süzme.xls

 

[Vedat Özer]

Selam,


A sütunu ile C Sütunu arasında otomatik filtre yapın,

Veri/Filtre Uygula/Otomatik filtre uygula,

C sütunnundaki filtrelemesine tıklayıp özel'den

İlk tarih için Büyük yada eşittit yapıp karşındaki yere tarih yazıp

Ve tıklayıp

küçük yada eşittire tıklayıp tamam dedikten sonra sonuca ulaşabilirsiniz.

 

[chngrcn]

userform ekledim..

Private Sub CommandButton1_Click()

Dim i As Long, sat1 As Long, sat2 As Long, s1 As Worksheet, s2  As Worksheet
If Not IsDate(TextBox1.Text) Then
    MsgBox "İlk Tarih geçerli bir tarih olmalıdır." & vbLf & "Rapor çıkarılmadı", vbCritical, "UYARI"
    TextBox1.SetFocus
    TextBox1.SelStart = 0
    TextBox1.SelLength = Len(TextBox1.Text)
    Exit Sub
End If
If Not IsDate(TextBox2.Text) Then
    MsgBox "İlk Tarih geçerli bir tarih olmalıdır." & vbLf & "Rapor çıkarılmadı", vbCritical, "UYARI"
    TextBox2.SetFocus
    TextBox2.SelStart = 0
    TextBox2.SelLength = Len(TextBox2.Text)
    Exit Sub
End If
If CDate(TextBox1.Text) > CDate(TextBox2.Text) Then
    MsgBox "Son tarih ilk tarihten büyük olamaz." & vbLf & "Rapor çıkarılmadı", vbCritical, "UYARI"
    TextBox2.SetFocus
    TextBox2.SelStart = 0
    TextBox2.SelLength = Len(TextBox2.Text)
    Exit Sub
End If
'Worksheets("LİSTE1").Range("A2:IV65536").ClearContents
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")

sat1 = s1.Cells(65536, "B").End(xlUp).Row
sat2 = s2.Cells(65536, "B").End(xlUp).Row + 1
Application.ScreenUpdating = False
For i = 5 To sat1
    If s1.Cells(i, "B").Value >= CDate(TextBox1.Text) And _
    s1.Cells(i, "B").Value <= CDate(TextBox2.Text) Then
              If sat2 >= 65533 Then
                MsgBox "VERİTABANI1 sayfasında satır doldu" & vbLf & _
                "Bulunan kayıtların tamamı aktarılmadı!", vbCritical, "UYARI"
                Exit Sub
            End If
            
            s2.Cells(sat2, "A").Value = s1.Cells(i, "A").Value
            s2.Cells(sat2, "B").Value = s1.Cells(i, "B").Value
            s2.Cells(sat2, "C").Value = s1.Cells(i, "C").Value
            s2.Cells(sat2, "D").Value = s1.Cells(i, "D").Value
            s2.Cells(sat2, "E").Value = s1.Cells(i, "E").Value
            s2.Cells(sat2, "F").Value = s1.Cells(i, "F").Value
            s2.Cells(sat2, "G").Value = s1.Cells(i, "G").Value
            s2.Cells(sat2, "H").Value = s1.Cells(i, "H").Value
            s2.Cells(sat2, "I").Value = s1.Cells(i, "I").Value
            s2.Cells(sat2, "J").Value = s1.Cells(i, "J").Value
            s2.Cells(sat2, "K").Value = s1.Cells(i, "K").Value

            
            sat2 = sat2 + 1
        End If
    Next i
c1 = TextBox1.Value
c2 = TextBox2.Value

Application.ScreenUpdating = True
MsgBox c1 & " ve " & c2 & " tarihleri arasındaki VERİLER aktarıldı." & vbLf & _
"", vbOKOnly + vbInformation, "AKTARIM UYARISI"
Unload UserForm6

End Sub

Private Sub CommandButton2_Click()
Unload UserForm6
End Sub

Private Sub TextBox1_AfterUpdate()
TextBox1.Text = Format(TextBox1.Text, "dd.mm.yyyy")
End Sub


Private Sub TextBox2_AfterUpdate()
TextBox2.Text = Format(TextBox2.Text, "dd.mm.yyyy")
End Sub

Private Sub Calendar1_Click()
TextBox1.Value = Format(Calendar1.Value)
Calendar1.Visible = True
TextBox1.SetFocus
End Sub
Private Sub Calendar2_Click()
TextBox2.Value = Format(Calendar2.Value)
Calendar2.Visible = True
TextBox2.SetFocus
End Sub

Private Sub UserForm6_Initialize()
Dim nesne As Control
Me.Calendar1.Visible = True
For Each nesne In Me.Controls
    If TypeName(nesne) = "TextBox1" Then
        i = i + 1
        ReDim Preserve txt(i)
        Set txt(i).txt = nesne
    End If
Next
Me.Calendar1.Value = Date
End Sub

inceleyiniz..

 

[manisalı88]

Çok teşekkür ederim elinize sağlık ama ben süzme tablosunu ( tarih girdiğimiz tabloyu) nasıl getireceğim. ekrandaki butona mı bağladınız

 

[chngrcn]

Evet ekrandaki butona tikladiginizda userform6 aciliyor.. calender ( takvim )'den tarihleri seçtinizde textbox lara tarihi otomatik atiyor.. özet döküm al butonuna tıkladığınızda
belirtitğiniz tarihler arasini süzüyor..

Rica ederim, iyi çalışmalar..