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.

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
 
[COLOR=darkgreen]'UYGULANAN KODUN AÇIKLAMALARI[/COLOR]
[COLOR=darkgreen]'1. SATIR > MAKROMUZA İSİM VERİYORUZ.[/COLOR]
[COLOR=darkgreen]'2. SATIR > İŞLEMLER YAPILIRKEN GÖZÜ YORMAMAK İÇİN EKRAN HAREKETLERİNİ PASİF YAPIYORUZ.[/COLOR]
[COLOR=darkgreen]'3-4. SATIR > SAYFA İSİMLERİNİ KISALTILMIŞ SABİTLERE ATIYORUZ.[/COLOR]
[COLOR=darkgreen]'5-9. SATIR > RAPOR ALMAK İÇİN KULLANILACAK HÜCRELERİNDEKİ [G2:K2] DEĞERLERİ DEĞİŞKENLERE ATIYORUZ.[/COLOR]
[COLOR=darkgreen]'10. SATIR > RAPOR SAYFASINDAKİ DAHA ÖNCE ALINAN RAPORA AİT VERİLERİ SİLİYORUZ.[/COLOR]
[COLOR=darkgreen]'11. SATIR > LİSTE İSİMLİ SAYFAYI SEÇİYORUZ.[/COLOR]
[COLOR=darkgreen]'12. SATIR > LİSTE İSİMLİ SAYFANIN A1 HÜCRESİNİ SEÇİYORUZ.[/COLOR]
[COLOR=darkgreen]'13. SATIR > DAHA ÖNCE UYGULANAN FİLTREYİ KALDIRIYORUZ.[/COLOR]
[COLOR=darkgreen]'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.[/COLOR]
[COLOR=darkgreen]'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.[/COLOR]
[COLOR=darkgreen]'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.[/COLOR]
[COLOR=darkgreen]'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.[/COLOR]
[COLOR=darkgreen]'38. SATIR > LİSTE İSİMLİ SAYFADAKİ KRİTERLERE UYGUN VERİLER SÜZÜLÜP SÜZÜLMÜŞ ALAN KOPYALANIYOR.[/COLOR]
[COLOR=darkgreen]'39. SATIR > RAPOR İSİMLİ SAYFAYI SEÇİYORUZ.[/COLOR]
[COLOR=darkgreen]'40. SATIR > RAPOR İSİMLİ SAYFANIN A1 HÜCRESİNİ SEÇİYORUZ.[/COLOR]
[COLOR=darkgreen]'41. SATIR > KOPYALANAN VERİLER A1 HÜCRESİNDEN İTİBAREN YAPIŞTIRILIYOR.[/COLOR]
[COLOR=darkgreen]'42. SATIR > KOPYALAMA İŞLEMİ HALA AKTİF HALDE OLDUĞUNDAN PASİF HALE GETİRİLİYOR.[/COLOR]
[COLOR=darkgreen]'43. SATIR > RAPOR İSİMLİ SAYFADAKİ [A:E] SÜTUNLARI EN UYGUN GENİŞLİK AYARINA GÖRE AYARLANIYOR.[/COLOR]
[COLOR=darkgreen]'44. SATIR > RAPOR İSİMLİ SAYFANIN A1 HÜCRESİNİ SEÇİYORUZ.[/COLOR]
[COLOR=darkgreen]'45. SATIR > LİSTE İSİMLİ SAYFAYI SEÇİYORUZ.[/COLOR]
[COLOR=darkgreen]'46. SATIR > UYGULANAN FİLTREYİ KALDIRIYORUZ.[/COLOR]
[COLOR=darkgreen]'47. SATIR > RAPOR İSİMLİ SAYFAYI SEÇİYORUZ.[/COLOR]
[COLOR=darkgreen]'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.[/COLOR]
[COLOR=darkgreen]'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.[/COLOR]
[COLOR=darkgreen]'50-51. SATIR > BU SORGU SONUCU SIFIR İSE KULLANICIYA KRİTERLERE UYGUN KAYIT OLMADIĞINA DAİR BİLGİLENDİRME MESAJI VERİYORUZ.[/COLOR]
[COLOR=darkgreen]'52. SATIR > UYGUN KAYIT BULUNAMADIĞI İÇİN LİSTE İSİMLİ SAYFAYI SEÇİYORUZ.[/COLOR]
[COLOR=darkgreen]'53. SATIR > SORGU SONUCU SIFIR ÇIKTIĞI İÇİN MAKROYU SONLANDIRIYORUZ.[/COLOR]
[COLOR=darkgreen]'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.[/COLOR]
[COLOR=darkgreen]'55. SATIR > MAKROMUZU SONLANDIRIYORUZ.[/COLOR]

 

[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]

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]

Merhaba

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çuk1]

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&#305;t yaz&#305;lm&#305;&#351;t&#305;r."
sonuc = MsgBox(kayit, vbOKOnly, "&#304;&#351;lem Tamamland&#305;!..")
End Sub

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

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]

yeni başlık

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
[COLOR=red]For d = 7 To 11[/COLOR]
[COLOR=red]Select Case d[/COLOR]
[COLOR=red]Case 7:[/COLOR] If s1.[g2] <> "" And s1.Cells(a, "b") <> s1.[g2] Then GoTo 20
[COLOR=red]Case 8:[/COLOR] If s1.[h2] <> "" And s1.Cells(a, "c") <> s1.[h2] Then GoTo 20
[COLOR=red]Case 9:[/COLOR] If s1.[I2] <> "" And s1.Cells(a, "d") < s1.[I2] Then GoTo 20
[COLOR=red]Case 10:[/COLOR] If s1.[j2] <> "" And s1.Cells(a, "d") > s1.[j2] Then GoTo 20
[COLOR=red]Case 11:[/COLOR] If s1.[k2] <> "" And s1.Cells(a, "e") < s1.[k2] Then GoTo 20
[COLOR=red]End Select[/COLOR]
[COLOR=red]Next[/COLOR]
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