İki Tarih Arasında Süzme İşlemi

[mustafa1205]

Örnek dosyamda açıklama yapmaya çalıştım.İki tarih arasında süzme işlemi ile ilgili bir sorum olacak . Teşekkür ediyorum.

 

[Orion1]

Dosyanız ektedir.

Sub SIRALAMAYAP()
Dim sat As Long
Application.ScreenUpdating = False
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
sat = Cells(65536, "A").End(xlUp).Row
Range("A3:E" & sat).AutoFilter
ActiveSheet.Range("$A$3:$E$" & sat).AutoFilter Field:=2, Criteria1:= _
">=" & CLng(CDate(Range("B1"))), Operator:=xlAnd, Criteria2:="<=" _
& CLng(CDate(Range("B2")))
ActiveSheet.Range("$A$3:$E$18").AutoFilter Field:=5, Criteria1:= _
Range("C1").Value
Range("A3:E" & sat).CurrentRegion.Copy Sheets("Sayfa2").Range("A1")
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
Sheets("Sayfa2").Select
Application.ScreenUpdating = False
End Sub

 

[N.Ziya Hiçdurmaz]

yanıt

Sub SIRALAMAYAP()
ActiveSheet.Range("$A$3:$E$18").AutoFilter Field:=2, Criteria1:= _
">=" & CLng(CDate(Range("B1"))), Operator:=xlAnd, Criteria2:="<=" _
& CLng(CDate(Range("B2")))
If [c1] = "" Then GoTo git
ActiveSheet.Range("$A$3:$E$18").AutoFilter Field:=5, Criteria1:=[c1]
Exit Sub
git:
End Sub

 

[mustafa1205]

Sayın Orion1 Hocam ve sayın Niyazi Hocam ellerinize sağlık çok teşekkür ediyorum.Tam istediğim gibi olmuş.İyi günler diliyorum

 

[mustafa1205]

Hocam kodu uyguladım herhangi bir sorun yok ancak örneğide ekliyorum işlem sonrası filtrelemeden çıkmak istiyorum.Kod da yapmaya çalıştım ancak yapamadım.Vaktiniz olursa ilgilenmenizi rica ediyorum.Teşekkür ediyorum

 

[İhsan Tank]

Hocam kodu uyguladım herhangi bir sorun yok ancak örneğide ekliyorum işlem sonrası filtrelemeden çıkmak istiyorum.Kod da yapmaya çalıştım ancak yapamadım.Vaktiniz olursa ilgilenmenizi rica ediyorum.Teşekkür ediyorum

Merhaba
Kodu boş bir module kopyalayıp dener misiniz_?
Süzme yapmaz direk iki tarih arasındaki verileri aktarır

Option Explicit
Sub tarih_Arası_aktar_61()
Dim ts, kaplan, trabzonspor, s1, s2
s1 = "Sayfa1": s2 = "Sayfa2"
trabzonspor = MsgBox(Format(Sheets(s2).Range("B1"), "dd.mm.yyyy") & " İle " & _
Format(Sheets(s2).Range("B2"), "dd.mm.yyyy") & " Arasındaki ( " & Sheets(s2). _
Range("C1") & " ) Verilerini Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
kaplan = 4
Sheets(s2).Range("A4:E65536").ClearContents
For ts = 4 To Sheets(s1).Cells(65536, "A").End(xlUp).Row
If Sheets(s1).Cells(ts, "B") >= Sheets(s2).Range("B1") And _
Sheets(s1).Cells(ts, "B") <= Sheets(s2).Range("B2") And _
LCase(Sheets(s1).Cells(ts, "E")) = LCase(Sheets(s2).Range("C1")) Then
Sheets(s2).Cells(kaplan, "A") = Sheets(s1).Cells(ts, "A")
Sheets(s2).Cells(kaplan, "B") = Sheets(s1).Cells(ts, "B")
Sheets(s2).Cells(kaplan, "C") = Sheets(s1).Cells(ts, "C")
Sheets(s2).Cells(kaplan, "D") = Sheets(s1).Cells(ts, "D")
Sheets(s2).Cells(kaplan, "E") = Sheets(s1).Cells(ts, "E")
kaplan = kaplan + 1
End If
Next
Application.ScreenUpdating = True
MsgBox Format(Sheets(s2).Range("B1"), "dd.mm.yyyy") & " İle " & _
Format(Sheets(s2).Range("B2"), "dd.mm.yyyy") & " Arasındaki ( " & Sheets(s2). _
Range("C1") & " ) Verilerini Aktardım", vbInformation, "Bitiş"
End Sub

 

[assenucler]

Sayın Orion1, N. Ziya Hiçdurmaz ve İhsan Tank;

Günaydınlar ve iyi pazarlar.

Verilen tarih aralığında, meyvayı yazınca, sıralama ve süzme kodla yapılmakta..

Tarih aralığını değiştirmeden sadece "Meyve" adını değiştirirsek, önceki kaydı silip, yeni meyve adına göre süzme için kod üzerinde nasıl bir değişiklik gerekiyor.

Yardımınız için önceden teşekkürler.

Sevgi ve saygılar.

 

[mustafa1205]

Kod üzerinde değişiklik yapmanıza gerek yok sadece C1 hücresindeki meyvenin ismini değiştirmeniz yeterli.Mesela muz yazın deneyin...

 

[mustafa1205]

Sayın İhsan Hocam yazdığınız kod çok güzel olmuş.Ellerinize sağlık.Şuan onu anlamaya çalışıyorum asıl çalışmama uygulayabilmem için.Tekrar Çok Teşekkürler.Allah razı olsun

 

[Orion1]

İstediğiniz değişikliği yaptım.
Dosyayı 2 numaralı mesajdan indirebilirsiniz.

 

[assenucler]

Teşekkürler hocam...

 

[Orion1]

Teşekkürler hocam...

Rica ederim.
İyi çalışmalar.

 

[İhsan Tank]

Sayın İhsan Hocam yazdığınız kod çok güzel olmuş.Ellerinize sağlık.Şuan onu anlamaya çalışıyorum asıl çalışmama uygulayabilmem için.Tekrar Çok Teşekkürler.Allah razı olsun

Rica ederim
Allah Sizdende Razı Olsun
:yazici:

 

[mustafa1205]

Çok teşekkür ediyorum.Gayet güzel olmuş vede çok güzel bir şekilde kod çalışıyor.Emeği geçen tüm hocalarıma teşekkürlerimi sunuyorum...