Veri tabanından seçilen kriterlere göre sorgulama

[Levent Menteşoğlu]

Değerli Üyelerimiz

Aslında sorgulama konusu ile ilgili forumumuzda çok sayıda örnek mevcut, buna rağmen tüm çözümlerin birarada bulunması amacıyla bu konuyla ilgili bir soru hazırladım. VBA veya Fonksiyonlarla geliştireceğiniz çözümleri paylaşmanızı rica ederim.

Soru: Aşağıdaki resimde görüldüğü gibi toplam 50.000 satır veri içeren 5 sütunlu (A-E arası) bir veri tabanımız mevcuttur. Bu veri tabanından, G2-K2 arasındaki hücrelere yazılan kriterlere uygun veriler sorgulanarak rapor sayfasında listelenecektir. Tüm kriterlerin doldurulması zorunlu olmayacak ve sadece doldurulan kriterlere göre sorgulama yapılabilecektir.

Sorgulamada kullanılan dikkat edilecek özelliklerden önemli olan ikisi şöyledir,

1-Başlangıç tarihi eşit veya büyük, Bitiş tarihi ise eşit veya küçük şeklinde sorgulama yapılacaktır. Herhangi birisi boş ise diğerinin kriteri geçerlidir ayrıca her ikiside boş ise tüm tarihler dikkate alınacaktır.

2-Miktar, büyük veya eşit şeklinde sorgulanacaktır. Eğer boş bırakılırsa tüm miktarlar dikkate alınacaktır.

http://www.excel.web.tr/derres/leventm/arama.JPG

Not: Veri sayısını özellikle fazla miktarda tuttum. Bundaki amacımda tasarlanacak çözümde sorgulama hızınıda dikkate alabilmenizdir.

[hamitcan]

Advanced filter yöntemiyle bir örnek yaptım. Yalnız burada Başlangıç ve Bitiş tarihlerini Geliş tarihi olarak değiştirmek gerekiyor.

Private Sub CommandButton1_Click()
[b1:e50001].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[g1:k2], CopyToRange:=Sayfa1.[b1:e1], Unique:=False
End Sub

[Korhan Ayhan]

Selamlar,

Bu soru için excelin yerleşik işlevlerinden filtreleme yönteminin en uygun çözüm olduğunu düşünüyorum.

Ekte bu yöntem ile ilgili çözümlemeyi bulabilirsiniz.


Uygulanan kod ve açıklamaları;

Sub ÖZET_RAPOR()
Application.ScreenUpdating = False
Set SL = Sheets("liste")
Set SR = Sheets("rapor")
Kriter1 = SL.[G2]
Kriter2 = SL.[H2]
Kriter3 = SL.[I2]
Kriter4 = SL.[J2]
Kriter5 = SL.[K2]
SR.Columns("A:E").Clear
SL.Select
[A1].Select
Selection.AutoFilter
If Kriter1 = "" Then
Selection.AutoFilter Field:=2
Else
Selection.AutoFilter Field:=2, Criteria1:=Kriter1
End If
If Kriter2 = "" Then
Selection.AutoFilter Field:=3
Else
Selection.AutoFilter Field:=3, Criteria1:=Kriter2
End If
If Kriter3 = "" And Kriter4 = "" Then
Selection.AutoFilter Field:=4
ElseIf Kriter3 <> "" And Kriter4 = "" Then
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(CDate(Kriter3))
ElseIf Kriter3 = "" And Kriter4 <> "" Then
Selection.AutoFilter Field:=4, Criteria1:="<=" & CLng(CDate(Kriter4))
ElseIf Kriter3 <> "" And Kriter4 <> "" Then
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(CDate(Kriter3)), Operator:=xlAnd, Criteria2:="<=" & CLng(CDate(Kriter4))
End If
If Kriter5 = "" Then
Selection.AutoFilter Field:=5
Else
Selection.AutoFilter Field:=5, Criteria1:=">=" & Kriter5
End If
SL.[A1].CurrentRegion.Copy
SR.Select
[A1].Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:E").EntireColumn.AutoFit
[A1].Select
SL.Select
Selection.AutoFilter
SR.Select
Application.ScreenUpdating = True
SAY = WorksheetFunction.CountA(SR.[A2:A65536])
If SAY = 0 Then
MsgBox "VERDİĞİNİZ KRİTERLERE UYGUN KAYIT BULUNAMAMIŞTIR.", vbExclamation, "DİKKAT !"
SL.Select
Exit Sub: End If
If SAY > 0 Then MsgBox "VERDİĞİNİZ KRİTERLERE UYGUN " & Format(SAY, "#,##0") & " ADET KAYIT BULUNMUŞTUR.", vbInformation
End Sub

'UYGULANAN KODUN AÇIKLAMALARI
'1. SATIR > MAKROMUZA İSİM VERİYORUZ.
'2. SATIR > İŞLEMLER YAPILIRKEN GÖZÜ YORMAMAK İÇİN EKRAN HAREKETLERİNİ PASİF YAPIYORUZ.
'3-4. SATIR > SAYFA İSİMLERİNİ KISALTILMIŞ SABİTLERE ATIYORUZ.
'5-9. SATIR > RAPOR ALMAK İÇİN KULLANILACAK HÜCRELERİNDEKİ [G2:K2] DEĞERLERİ DEĞİŞKENLERE ATIYORUZ.
'10. SATIR > RAPOR SAYFASINDAKİ DAHA ÖNCE ALINAN RAPORA AİT VERİLERİ SİLİYORUZ.
'11. SATIR > LİSTE İSİMLİ SAYFAYI SEÇİYORUZ.
'12. SATIR > LİSTE İSİMLİ SAYFANIN A1 HÜCRESİNİ SEÇİYORUZ.
'13. SATIR > DAHA ÖNCE UYGULANAN FİLTREYİ KALDIRIYORUZ.
'14-18. SATIR > LİSTE İSİMLİ SAYFADAKİ G2 (ÜRÜN ADI) HÜCRESİNİN BOŞ OLUP OLMADIĞI KONTROL EDİLİYOR.EĞER BOŞSA TÜM ÜRÜNLER RAPORA DAHİL EDİLİYOR.
'19-23. SATIR > LİSTE İSİMLİ SAYFADAKİ H2 (RENK) HÜCRESİNİN BOŞ OLUP OLMADIĞI KONTROL EDİLİYOR.EĞER BOŞSA TÜM RENKLER RAPORA DAHİL EDİLİYOR.
'24-32. SATIR > LİSTE İSİMLİ SAYFADAKİ I2 (BAŞLANGIÇ TARİHİ) VE J2 (BİTİŞ TARİHİ) HÜCRELERİNİN BOŞ OLUP OLMADIĞI KONTROL EDİLİYOR.EĞER BOŞSA TÜM TARİHLER RAPORA DAHİL EDİLİYOR.
'33-37. SATIR > LİSTE İSİMLİ SAYFADAKİ K2 (MİKTAR) HÜCRESİNİN BOŞ OLUP OLMADIĞI KONTROL EDİLİYOR.EĞER BOŞSA TÜM MİKTARLAR RAPORA DAHİL EDİLİYOR.
'38. SATIR > LİSTE İSİMLİ SAYFADAKİ KRİTERLERE UYGUN VERİLER SÜZÜLÜP SÜZÜLMÜŞ ALAN KOPYALANIYOR.
'39. SATIR > RAPOR İSİMLİ SAYFAYI SEÇİYORUZ.
'40. SATIR > RAPOR İSİMLİ SAYFANIN A1 HÜCRESİNİ SEÇİYORUZ.
'41. SATIR > KOPYALANAN VERİLER A1 HÜCRESİNDEN İTİBAREN YAPIŞTIRILIYOR.
'42. SATIR > KOPYALAMA İŞLEMİ HALA AKTİF HALDE OLDUĞUNDAN PASİF HALE GETİRİLİYOR.
'43. SATIR > RAPOR İSİMLİ SAYFADAKİ [A:E] SÜTUNLARI EN UYGUN GENİŞLİK AYARINA GÖRE AYARLANIYOR.
'44. SATIR > RAPOR İSİMLİ SAYFANIN A1 HÜCRESİNİ SEÇİYORUZ.
'45. SATIR > LİSTE İSİMLİ SAYFAYI SEÇİYORUZ.
'46. SATIR > UYGULANAN FİLTREYİ KALDIRIYORUZ.
'47. SATIR > RAPOR İSİMLİ SAYFAYI SEÇİYORUZ.
'48. SATIR > DAHA ÖNCE İŞLEMLER YAPILIRKEN GÖZÜ YORMAMAK İÇİN EKRAN HAREKETLERİNİ PASİF YAPMIŞTIK.BU İŞLEMİ TEKRAR AKTİF HALE GETİRİYORUZ.
'49. SATIR > RAPOR İSİMLİ SAYFADAKİ [A2:A65536] ARALIĞINDAKİ DOLU HÜCRELERİ SAYDIRIP SIFIR DEĞERİNE EŞİT OLUP OLMADIĞINI SORGULUYORUZ.BU DEĞERİ SAY İSİMLİ DEĞİŞKENE ATIYORUZ.
'50-51. SATIR > BU SORGU SONUCU SIFIR İSE KULLANICIYA KRİTERLERE UYGUN KAYIT OLMADIĞINA DAİR BİLGİLENDİRME MESAJI VERİYORUZ.
'52. SATIR > UYGUN KAYIT BULUNAMADIĞI İÇİN LİSTE İSİMLİ SAYFAYI SEÇİYORUZ.
'53. SATIR > SORGU SONUCU SIFIR ÇIKTIĞI İÇİN MAKROYU SONLANDIRIYORUZ.
'54. SATIR > 49. SATIRDAKİ SORGU SONUCU SIFIRDAN BÜYÜKSE KODLAR BU SATIRA OTOMATİK OLARAK GEÇECEKTİR.KULLANICIYA VERDİĞİ KRİTERLERE UYGUN KAYIT SAYISINI BELİRTEN BİLGİLENDİRME MESAJI VERİYORUZ.
'55. SATIR > MAKROMUZU SONLANDIRIYORUZ.

[AS3434]

Sorunun çözümü için fonksiyonlarla biraz uğraştım ama daha 10.000. satırda dosya 13 MB'a çıktı ve hesaplama 1 dakikayı geçti. Tabi bunda seçmiş olduğum fonksiyonların ve hesaplama yönteminin de etkisi büyük. En mantıklı çözüm VBA ile yapılması.

[Zeki Gürsoy]

Hem ADO hem de DAO ile yapılmış örnek.
Ek olarak sıralama kriteri ekledim.

[AS3434]

Renk sütunu da seçeneğe dahil edilmiş, 1000 satırlık veri ile oluşmuş dosyanın, fonksiyonla yapabildiğim çözümü ekte.
Yalnız, dediğim gibi satır sayısı artınca dosya ebatları yükseliyor ve hesaplama uzun zaman alıyor.

[Necdet Yeşertener]

Bende birşeyler yapmaya çalıştım, amacım yanıt vermek değil, öğrenmek içindir.

[Korhan Ayhan]

Selamlar,

Arkadaşlar eklediğim dosyada kullanıcıyı bilgilendirmek için kullandığım mesajda problem vardı. Bu hatayı giderip dosyayı güncelledim.

[acemiler]

Nejdet Yesersener'in verdiği cevapta veri süzülüp başka bir sayfaya aktarılıyor. Peki Aranacak veri bir satırda değilde alt alta 50 satırda değişik aranacak veriler olsa bu 50 satırdaki verileri bulup süzebilir mi? Teşekkürler

[Korhan Ayhan]

Selamlar,

Sn. acemiler sorularınızı bu başlık altına değilde makrolar kısmına bu linki ekleyerek sorarsanız daha faydalı olacaktır. Zira bu bölüme sorulan soruyla ilgili cevapların yazılması daha uygun olacaktır.

[Selçuk]

iyi geceler değerli üstadlarım ve değerli üyeler,

vba ile bir alternatif de ben düşündüm. sayın üstadlarımın yorumlarını bekliyorum. :):)

Sub listele()
On Error Resume Next
Set s1 = Sheets("liste")
Set s2 = Sheets("rapor")
s2.[a2:e50000].ClearContents
For sat = 2 To [a65536].End(3).Row
If s1.Cells(sat, "b") = s1.[g2] Then
If s1.Cells(sat, "c") = s1.[h2] Then
If s1.[ı2] = "" Then GoTo devam
If s1.Cells(sat, "d") >= s1.[I2] Then
devam:
If s1.[j2] = "" Then GoTo devammm
If s1.Cells(sat, "d") <= s1.[j2] Then
devammm:
If s1.Cells(sat, "e") >= s1.[k2] Then
c = c + 1
s2.Cells(c + 1, "a") = c
s2.Cells(c + 1, "b") = s1.Cells(sat, "b")
s2.Cells(c + 1, "c") = s1.Cells(sat, "c")
s2.Cells(c + 1, "d") = CDate(s1.Cells(sat, "d"))
s2.Cells(c + 1, "e") = s1.Cells(sat, "e")
End If
End If
End If
End If
End If
Next
kayit = "Kriterlere uyan " & s2.[a65536].End(3).Row - 1 & " adet kayıt yazılmıştır."
sonuc = MsgBox(kayit, vbOKOnly, "İşlem Tamamlandı!..")
End Subsaygılar.

[Levent Menteşoğlu]

Benim düşündüğüm 3 çözüm yolu vardı, bunlar auto filter özeliğinin kullanılması, ADO ve klasik döngü yöntemi ile çözümdür. Değerli arkadaşlarımız her üç yöntemide içeren çözümlerinide sunmuş durumdalar. Hatta zor bir çözüm olsada Sn AS3434 fonksiyonlarlada ilginç bir çözüm geliştirmiş durumda. Bu çözümlerden sonra bende klasik döngü yöntemi ile hazırladığım çözümü sizlerle paylaşmak istiyorum. Bu çözüm tüm kriter ihtimallerini dikkate almaktadır. Bu arada Sn cellchuq sizide gayretiniz nedeniyle tebrik ediyorum. Bende sizinle aynı mantığı kullandım. Yalnız sizin çözümünüz tüm kriterleri dikkate almıyor, bunu dikkate alarak kodu biraz daha geliştirebilirsiniz.

Sub sorgula()
Set s1 = Sheets("liste")
Set s2 = Sheets("rapor")
basla = Time
s2.[a2:e65536].ClearContents
For a = 2 To [b65536].End(3).Row
For d = 7 To 11
Select Case d
Case 7: If s1.[g2] <> "" And s1.Cells(a, "b") <> s1.[g2] Then GoTo 20
Case 8: If s1.[h2] <> "" And s1.Cells(a, "c") <> s1.[h2] Then GoTo 20
Case 9: If s1.[I2] <> "" And s1.Cells(a, "d") < s1.[I2] Then GoTo 20
Case 10: If s1.[j2] <> "" And s1.Cells(a, "d") > s1.[j2] Then GoTo 20
Case 11: If s1.[k2] <> "" And s1.Cells(a, "e") < s1.[k2] Then GoTo 20
End Select
Next
c = c + 1
s2.Range("a" & c + 1 & ":e" & c + 1) = s1.Range("a" & a & ":e" & a).Value
20 Next
bitis = Time
MsgBox c & " adet veri bulunmuştur." & Chr(13) & Chr(13) & "Sorgulama Süresi: " & Format(bitis - basla, "hh:mm:ss")
End Sub

'1-s1 değişkeni liste isimli sayfa olarak tanımlanır.
'2-s2 değişkeni rapor isimli sayfa olarak tanımlanır.
'3-başlangıç zamanı basla değişkenine atanır.
'4-rapor sayfası temizlenir.
'5-verileri tarayan döngü başlangıcıdır.
'6-kriterleri tarayan döngü başlangıcıdır.
'7-11 arası bu kısımda taranan satırdaki ilgili sütunlar kriterler ile karşılaştırılır.
'kriterleri tarayan döngünün sonu
'c değişkeni her seferinde bir arttırılır, bu değer rapor sayfasındaki sıra nosudur.
'kirterlere uyan satır, rapor sayfasına aktarılır.
'verileri tarayan döngünün sonu
'işlemin bitiş zamanı bitis değişkenine atanır.
'bulunan veri sayısı ve işlem süresi mesaj penceresinde gösterilir.


Not: Tüm verileri taramasına rağmen benim pc de oldukça hızlı çalıştığını söyleyebilirim. Tek veride 20 sn, çoklu aramalarda 7 sn civarında. (işlemci amd athlon 1.9 Ghz- 1.0 Gb ram)
Zafer:Merhaba benimki 4 sn

[takirti]

Sayın Leventm gerçekten çok hızlı çalışıyor. Tebrikler.

[bulentcigali]

böyle bir başlık açmış olmanız gerçekten bizleri çok sevindirdi.bu konu ile ilgili form sayfasına defalarca sorunumu iletmiştim ama cevap alamamıştım.fakat bu çalışmanız sayesinde birden fazla kriterle sorgulama yapabileceğim.bu çalışmalarınızdan dolayı başta leventm ve diğer arkadaşlara teşekkür eder, çalışmalarınızda başarılar dilerim.

[enteresan]

Çok güzel bir uygulama olmuş. Böylelikle biz de birşeyler öğrenebiliyoruz. Tüm emeği geçenlere saygılar....

[Mahmut Kök]

Makrolar bölümünde başlık açıp da, nasıl yaparız diye düşündüğüm seçeneğe bağlı çoklu arama konusuna cevap bulduğum için kendimi şanslı bulduğumu öncelikle belirtip, katkıda bulunan herkese teşekkür ederim.

Sayın Leventm,
Çözüm önerilerinizden biri olan, yukarıda verdiğiniz koddaki kriter tarama döngüsünü kaldırdığımızda, yani aşağıdaki bölümde yer alan kırmızı renkli yerleri sildiğimizde işlem, bazı denemelerimde 1 saniye daha kısa sürdü.

Ben, bu döngüyü kullanmanızın, program açısından özel bir sebebi olup olmadığını öğrenmek isterim.


...
For a = 2 To [b65536].End(3).Row
For d = 7 To 11
Select Case d
Case 7: If s1.[g2] <> "" And s1.Cells(a, "b") <> s1.[g2] Then GoTo 20
Case 8: If s1.[h2] <> "" And s1.Cells(a, "c") <> s1.[h2] Then GoTo 20
Case 9: If s1.[I2] <> "" And s1.Cells(a, "d") < s1.[I2] Then GoTo 20
Case 10: If s1.[j2] <> "" And s1.Cells(a, "d") > s1.[j2] Then GoTo 20
Case 11: If s1.[k2] <> "" And s1.Cells(a, "e") < s1.[k2] Then GoTo 20
End Select
Next
c = c + 1
...

[Levent Menteşoğlu]

Niye eklediğimi hatırlayamadım, şimdi dosyaya tekrar baktım, amacı sadece kodun hızını arttırmaya yönelik, özellikle tek kriterli sorguda süreyi ciddi olarak kısaltacaktır, şöyle bir deneme yapabilirsiniz, örneğin sadece G2 hücresine "KALEM" kriterini yazın ve diğer hücrelerdeki kriterleri silin ve kodu benim verdiğim şekilde çalıştırın. Sonrasındada kırmızı ile işaretlediğiniz kısımları kaldırarak kodu tekrar çalıştırın ve her iki durumdada listeleme süresini karşılaştırın.

[Levent Menteşoğlu]

Yukarıdaki mesajımı dikkate almayın, yanlış değerlendirme yapmışım, evet haklısınız galiba ortadaki döngü ve select case komutlarını kaldırınca hızda bir farklılık olmuyor, uyarınız ve dikkatiniz için teşekkür ederim.

[sherlockholmes]

Açıklamalar için teşekkürler..

Çok faydalı bilgiler aktarmışsınız..

Kolay gelsin.

[thekilled]

YA vermiş olduğunuz dosyalara tıklayınca boş sayfa çıkıyor yardım lütfen

[Levent Menteşoğlu]

Tüm dosyalar tekrar eklenmiştir.

[alibaskan]

Benim sorum veritabanından yapılacak sorgulamalarda kayıtlar muhtemelen çok fazla sayıda olacağı için excele çok yük binmektedir. Bu nedenle excele veritabanındaki tablo veya tabloların tamamını çekmek yerine sadece ihtiyacımız olan en özet halini sql cümlesinde where kısmında süzerek getirip hatta bu kısıma excele bağlanan parametreler koyup sonucu excele dökmek daha uygun olmaz mı? Özellikle hız açısından. Çalıştığım şirkette uzun süredir bu yöntemi kullanıyorum. Çok ta verimli oluyor. Yani parametreleri excelin fonksiyonları ile değil de sql cümlesinde halletmek daha mantıklı olmaz mı?

[adcetin]

http://pic1.resimupload.com/r9/thumb_782208758.JPG (www.resimupload.com/ds782208758_liste.html)

arkadaşlar dosyam çok büyük olduğu için gönderemiyorum. BEn resimde anlattığım gibi listeden seçtiğim kriterlerin yukarıya ölçüt olarak yazılmasını istiyorum. Mümkünmü mümkünse yardımlarınız için şimdiden çok teşekkürler

[Korhan Ayhan]

Selamlar,

Sn. adcetin,

Burası konuyla ilgili çözümleri sunacağınız bölümdür. Siz buraya sorunuzu sormuşsunuz. Konunuzun içeriğine göre ya MAKRO ya da FONKSİYONLAR bölümüne ayrı bir başlık açarak sorunuzu sorunuz.

[Milady Meriç]

Zamanında ne kadar değerli paylaşımlar olmuş.

Çok güzel ve eğitici, herkesin emeğine sağlık.

Kolay gelsin.