• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

veri çağırma

E

emre311

Katılım
16 Nisan 2010
Mesajlar
170
Excel Vers. ve Dili
Microsoft Office 2010 türkçe
Merhaba arkadaşlar;
Veri çağırma için yazdığımız kodda 4 koşulun boş olma ihtimallerini yazdığımda veriyi getirme işi çok uzun sürmeye başladı acaba bunun bi çaresi varmı daha kısa sürede getirmesi için. vba konusunda yeniyim yardımlarınızı bekliyorum.

Sub Düğme27_Tıklat()
If Sayfa6.[D17] = "" Or Sayfa6.[J17] = "" Or Sayfa6.[J19] = "" Then
MsgBox "ARAMA YAPABİLMENİZ İÇİN LÜTFEN BAŞLANGIÇ-BİTİŞ TARİHİ VE ÜNİTE ADINI GİRİNİZ"
Sheets("KAPAK").Select
Exit Sub
Else
End If
Dim sat As Integer
Dim s, ss As Integer
Dim bul As Object
Sayfa6.[a28:n1000].Clear
s = 28
ss = 28
son = Sayfa1.Cells(Rows.Count, "H").End(xlUp).Row
Set bul = Sayfa1.Range("H2:H" & son).Find(Sayfa6.[D17], , xlValues, xlWhole)
If Not bul Is Nothing Then
adres = bul.Address
Do
If Sayfa6.[J17] <= Sayfa1.Cells(bul.Row, "A") And Sayfa6.[J19] >= Sayfa1.Cells(bul.Row, "A") And Sayfa1.Cells(bul.Row, "E") = Sayfa6.[D23] And Sayfa1.Cells(bul.Row, "O") = Sayfa6.[D25] And Sayfa1.Cells(bul.Row, "J") = Sayfa6.[D21] And Sayfa1.Cells(bul.Row, "G") = Sayfa6.[D19] Then
Sayfa6.Cells(s, "a") = Format(Sayfa1.Cells(bul.Row, "a"), "dd.mm.yyyy")
Sayfa6.Cells(s, "b") = Sayfa1.Cells(bul.Row, "b")
Sayfa6.Cells(s, "c") = Sayfa1.Cells(bul.Row, "c")
Sayfa6.Cells(s, "d") = Sayfa1.Cells(bul.Row, "d")
Sayfa6.Cells(s, "e") = Sayfa1.Cells(bul.Row, "e")
Sayfa6.Cells(s, "f") = Sayfa1.Cells(bul.Row, "f")
Sayfa6.Cells(s, "g") = Sayfa1.Cells(bul.Row, "g")
Sayfa6.Cells(s, "h") = Sayfa1.Cells(bul.Row, "h")
Sayfa6.Cells(s, "ı") = Sayfa1.Cells(bul.Row, "ı")
Sayfa6.Cells(s, "j") = Sayfa1.Cells(bul.Row, "j")
Sayfa6.Cells(s, "k") = Sayfa1.Cells(bul.Row, "k")
Sayfa6.Cells(s, "l") = Sayfa1.Cells(bul.Row, "l")
Sayfa6.Cells(s, "m") = Sayfa1.Cells(bul.Row, "m")
Sayfa6.Cells(s, "n") = Sayfa1.Cells(bul.Row, "n")
s = s + 1
End If
If Sayfa6.[D23] = "" And Sayfa6.[J17] <= Sayfa1.Cells(bul.Row, "A") And Sayfa6.[J19] >= Sayfa1.Cells(bul.Row, "A") And Sayfa1.Cells(bul.Row, "O") = Sayfa6.[D25] And Sayfa1.Cells(bul.Row, "J") = Sayfa6.[D21] And Sayfa1.Cells(bul.Row, "G") = Sayfa6.[D19] Then
Sayfa6.Cells(s, "a") = Format(Sayfa1.Cells(bul.Row, "a"), "dd.mm.yyyy")
Sayfa6.Cells(s, "b") = Sayfa1.Cells(bul.Row, "b")
Sayfa6.Cells(s, "c") = Sayfa1.Cells(bul.Row, "c")
Sayfa6.Cells(s, "d") = Sayfa1.Cells(bul.Row, "d")
Sayfa6.Cells(s, "e") = Sayfa1.Cells(bul.Row, "e")
Sayfa6.Cells(s, "f") = Sayfa1.Cells(bul.Row, "f")
Sayfa6.Cells(s, "g") = Sayfa1.Cells(bul.Row, "g")
Sayfa6.Cells(s, "h") = Sayfa1.Cells(bul.Row, "h")
Sayfa6.Cells(s, "ı") = Sayfa1.Cells(bul.Row, "ı")
Sayfa6.Cells(s, "j") = Sayfa1.Cells(bul.Row, "j")
Sayfa6.Cells(s, "k") = Sayfa1.Cells(bul.Row, "k")
Sayfa6.Cells(s, "l") = Sayfa1.Cells(bul.Row, "l")
Sayfa6.Cells(s, "m") = Sayfa1.Cells(bul.Row, "m")
Sayfa6.Cells(s, "n") = Sayfa1.Cells(bul.Row, "n")
s = s + 1
End If
If Sayfa6.[D25] = "" And Sayfa6.[J17] <= Sayfa1.Cells(bul.Row, "A") And Sayfa6.[J19] >= Sayfa1.Cells(bul.Row, "A") And Sayfa1.Cells(bul.Row, "E") = Sayfa6.[D23] And Sayfa1.Cells(bul.Row, "J") = Sayfa6.[D21] And Sayfa1.Cells(bul.Row, "G") = Sayfa6.[D19] Then
Sayfa6.Cells(s, "a") = Format(Sayfa1.Cells(bul.Row, "a"), "dd.mm.yyyy")
Sayfa6.Cells(s, "b") = Sayfa1.Cells(bul.Row, "b")
Sayfa6.Cells(s, "c") = Sayfa1.Cells(bul.Row, "c")
Sayfa6.Cells(s, "d") = Sayfa1.Cells(bul.Row, "d")
Sayfa6.Cells(s, "e") = Sayfa1.Cells(bul.Row, "e")
Sayfa6.Cells(s, "f") = Sayfa1.Cells(bul.Row, "f")
Sayfa6.Cells(s, "g") = Sayfa1.Cells(bul.Row, "g")
Sayfa6.Cells(s, "h") = Sayfa1.Cells(bul.Row, "h")
Sayfa6.Cells(s, "ı") = Sayfa1.Cells(bul.Row, "ı")
Sayfa6.Cells(s, "j") = Sayfa1.Cells(bul.Row, "j")
Sayfa6.Cells(s, "k") = Sayfa1.Cells(bul.Row, "k")
Sayfa6.Cells(s, "l") = Sayfa1.Cells(bul.Row, "l")
Sayfa6.Cells(s, "m") = Sayfa1.Cells(bul.Row, "m")
Sayfa6.Cells(s, "n") = Sayfa1.Cells(bul.Row, "n")
s = s + 1
End If
.
.
.
.
End If
Set bul = Sayfa1.Range("H3:H" & son).FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> adres
End If
son2 = Sayfa6.Cells(Rows.Count, "g").End(xlUp).Row
If Sayfa6.[A28] = "" Then
Exit Sub
Else
End If
Sheets("Data").Select
Range("A3:N3").Select
Selection.Copy
Sheets("Kapak").Select
Range("A28:N" & son2).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

formül uzun olduğu için kısalttım nokta olan yerler diğer şartlar yardımlarınız için şimdiden teşekkürler
 
Aklınızda bulunsun: üzerinde çalıştığınız dosyanızı eklerseniz daha kolay çözüm bulabilirsiniz...
 
kodun genel mantığı ile ilgili sorunum olduğu için dosyayı koyma gereksinimi duymadım hocam. genel olarak bu kodda şöle bi hata var şartları kontrol etti 1. satır veriyi getirdi. sonra tekrar her şartı dolaştı 2. satırı ekledi yani ondan süre uzun sürüyo bence şartı bulduğu anda datadan tüm verileri alacak ve işini bitirecek diğer şartları dolaşmıcak diye düşünüyorum. ama vba kodlarına biraz uzak olduğum için bu problemi çözemedim. sorumada cevap alamadım henüz :(
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst