Verileri Filtre İle Aktarma

[baydeniro]

Merhaba arkadaşlar. Bir tablodaki verilerin birden fazla filtre kullanılarak aktarılması konusunda yardımcı olabilir misiniz. Ekteki dosyada KAYIT sayfasında muhtelif veriler mevcuttur. Bu verileri RAPOR sayfasında 2. ve 3. satırda bulunan filtrelere göre KAYIT sayfasından RAPOR sayfasına kopyalanması mümkün müdür.

Kodun şu özelliği olabilir mi : Eğer bir filtre verilmemiş ise o zaman o sütundaki tüm verileri dikkate alacak. Filtre verilmiş ise sadece o filtreye eşit olanları dikkate alacak. Örneğin D2 hücresinde Ürün tanımı olarak Elma yazlırsa sadece Elma'ları dikkate alacak, D2 hücresi boş ise tüm ürünleri dikkate alacak. Tabii diğer filtreler için de aynı kural söz konusu. Sadece tarih başlangıcı B2, tarih bitişi B3 olacak, yani tarihi bir aralık olarak dikkate alacak.

Yardımcı olanlara, zamanını ayıranlara şimdiden teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Ekte örnek dosyanız üzerinde gerekli düzenlemeleri yaptım. İncelermisiniz.

Ayrıca konuyla ilgili olarak aşağıdaki linki incelermisiniz.

http://www.excel.web.tr/showthread.php?t=30754

 

[xxcell]

userform'da veri suzme ile ilgili ufak bir ornek hazirladim.
Fikir vermesi acisindan incelemenizi tavsiye ederim.

 

[baydeniro]

Teşekkürler

Sayın Cost Control elinize, beyninize saplık. Mükemmerl bir kod olmuş. Yine size yakışır bir iş. Bir küçük durum var. Vade tarihini filtre olarak verince dikkate almıyor. Gerçi çok önemli değil ama bu konuda birşey yapılabilir mi. Sağlıcakla kalın.

 

[Korhan Ayhan]

Selamlar,

Örnek dosyadaki kodu aşağıdaki şekilde değiştirip denermisiniz.

Sub RAPOR()
    Set SK = Sheets("KAYIT")
    Set SR = Sheets("RAPOR")
    SR.[A6:K65536].Clear
    SK.Select
    If SR.[A2] <> "" Then SK.[A1].AutoFilter Field:=1, Criteria1:=SR.[A2]
    If SR.[B2] <> "" And SR.[B3] <> "" Then SK.[A1].AutoFilter Field:=2, Criteria1:=">=" & CLng(CDate(SR.[B2])), Operator:=xlAnd, Criteria2:="<=" & CLng(CDate(SR.[B3]))
    If SR.[C2] <> "" Then SK.[A1].AutoFilter Field:=3, Criteria1:=SR.[C2]
    If SR.[D2] <> "" Then SK.[A1].AutoFilter Field:=4, Criteria1:=SR.[D2]
    If SR.[E2] <> "" Then SK.[A1].AutoFilter Field:=5, Criteria1:=SR.[E2]
    If SR.[F2] <> "" Then SK.[A1].AutoFilter Field:=6, Criteria1:=SR.[F2]
    If SR.[G2] <> "" Then SK.[A1].AutoFilter Field:=7, Criteria1:=SR.[G2]
    If SR.[H2] <> "" Then SK.[A1].AutoFilter Field:=8, Criteria1:=SR.[H2]
    If SR.[I2] <> "" Then SK.[A1].AutoFilter Field:=9, Criteria1:=SR.[I2]
    If SR.[J2] <> "" Then SK.[A1].AutoFilter Field:=10, Criteria1:=CDate(SR.[J2])
    If SR.[K2] <> "" Then SK.[A1].AutoFilter Field:=11, Criteria1:=SR.[K2]
    SK.[A1].CurrentRegion.Copy SR.[A5]
    SK.[A1].AutoFilter
    SR.Select
    Cells.EntireColumn.AutoFit
    MsgBox "RAPORLAMA &#304;&#350;LEM&#304; TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[baydeniro]

Tekrar Teşekkür Ederim

Sayın Cost Control, Allah sizden razı olsun, Allah sizin gibi beyinleri Türkiye'ye bağışlasın. Çok çok teşekkürler.

 

[egon77]

Merhaba,
Bu konudaki dosyalar güncellenebilir mi?