Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Beyin Fırtınası
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Beyin Fırtınası Bu başlıkta, ilginç olduğunu düşündüğünüz sorularınızı, bir problem şeklinde sorabilir, alternatif olduğunu düşündüğünüz çözümlerinizi paylaşabilirsiniz. (Bu başlıkta yeni konu açılması onaya bağlıdır.)
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 22-04-2007, 01:02   #11
Selçuk
 
Selçuk kullanıcısının avatarı
 
Giriş: 14/10/2006
Şehir: bAnDıRmA
Mesaj: 408
Excel Vers. ve Dili:
excel 2003 TR
Varsayılan

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.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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 Sub
saygılar.
__________________
[FONT=Lucida Console][B]Sözkonusu VATAN ise, gerisi teferruattır!..[/B][/FONT]

Bu mesaj en son " 22-04-2007 " tarihinde saat 01:14 itibariyle Selçuk tarafından düzenlenmiştir....
Selçuk Çevrimdışı   Alıntı Yaparak Cevapla
Eski 22-04-2007, 23:09   #12
Levent Menteşoğlu
Administrator
 
Levent Menteşoğlu kullanıcısının avatarı
 
Giriş: 13/10/2004
Şehir: Çorlu
Mesaj: 15,896
Excel Vers. ve Dili:
Excel 2010-Türkçe
Varsayılan

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.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
Eklenmiş Dosyalar
Dosya Türü: rar sorgulama.rar (670.9 KB, 403 Görüntülenme)
__________________
FORUM KURALLARI



"Biz burada hep beraber, sevginin,saygının, alınterinin, mutluluğun makrosunu yazıyoruz. " Kaylan

Bu mesaj en son " 15-07-2010 " tarihinde saat 23:13 itibariyle Levent Menteşoğlu tarafından düzenlenmiştir.... Neden: Dosya yeniden eklendi
Levent Menteşoğlu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 23-04-2007, 08:49   #13
takirti
 
takirti kullanıcısının avatarı
 
Giriş: 29/10/2006
Mesaj: 296
Excel Vers. ve Dili:
OFİS 2003 Türkçe
Varsayılan

Sayın Leventm gerçekten çok hızlı çalışıyor. Tebrikler.
__________________
TARİH BİR GÜN ÖLÜME SUSAMIŞ BİR TÜRKTEN DAHA KUVVETLİ BİR SİLAHIN OLMADIĞINI YAZMAK ZORUNDA KALACAKTIR....
takirti Çevrimdışı   Alıntı Yaparak Cevapla
Eski 03-05-2007, 09:48   #14
bulentcigali
 
Giriş: 20/07/2005
Mesaj: 270
Varsayılan 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.
bulentcigali Çevrimdışı   Alıntı Yaparak Cevapla
Eski 03-05-2007, 21:38   #15
enteresan
 
enteresan kullanıcısının avatarı
 
Giriş: 05/04/2006
Mesaj: 450
Excel Vers. ve Dili:
Office Excel 2003 TÜRKÇE
Varsayılan

Çok güzel bir uygulama olmuş. Böylelikle biz de birşeyler öğrenebiliyoruz. Tüm emeği geçenlere saygılar....
__________________
Bana bir harf öğretenin 40 yıl kölesi olurum.
enteresan Çevrimdışı   Alıntı Yaparak Cevapla
Eski 13-06-2007, 23:46   #16
Mahmut Kök
 
Mahmut Kök kullanıcısının avatarı
 
Giriş: 14/07/2006
Şehir: Adana
Mesaj: 830
Excel Vers. ve Dili:
Excel 2007 - Türkçe
Varsayılan

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.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
...
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
...
__________________
_______

Lütfen Türkçe...
Mahmut Kök Çevrimdışı   Alıntı Yaparak Cevapla
Eski 14-06-2007, 00:09   #17
Levent Menteşoğlu
Administrator
 
Levent Menteşoğlu kullanıcısının avatarı
 
Giriş: 13/10/2004
Şehir: Çorlu
Mesaj: 15,896
Excel Vers. ve Dili:
Excel 2010-Türkçe
Varsayılan

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.
__________________
FORUM KURALLARI



"Biz burada hep beraber, sevginin,saygının, alınterinin, mutluluğun makrosunu yazıyoruz. " Kaylan
Levent Menteşoğlu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 14-06-2007, 00:20   #18
Levent Menteşoğlu
Administrator
 
Levent Menteşoğlu kullanıcısının avatarı
 
Giriş: 13/10/2004
Şehir: Çorlu
Mesaj: 15,896
Excel Vers. ve Dili:
Excel 2010-Türkçe
Varsayılan

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.
__________________
FORUM KURALLARI



"Biz burada hep beraber, sevginin,saygının, alınterinin, mutluluğun makrosunu yazıyoruz. " Kaylan
Levent Menteşoğlu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 24-07-2008, 22:51   #19
sherlockholmes
 
Giriş: 21/05/2007
Mesaj: 30
Excel Vers. ve Dili:
Excel 2003 , Türkçe
Varsayılan

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

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

Kolay gelsin.
sherlockholmes Çevrimdışı   Alıntı Yaparak Cevapla
Eski 15-07-2010, 13:40   #20
thekilled
 
Giriş: 15/07/2010
Şehir: kahramanartvin :D
Mesaj: 7
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

YA vermiş olduğunuz dosyalara tıklayınca boş sayfa çıkıyor yardım lütfen
thekilled Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 12:30


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden