vba ile veri çağırma listeleme şartlı

[emre311]

örnekteki dosyada ki gibi bir vba koduna ihtiyacım var veri çağırma listeleme şartlı şimdiden teşekkür ederim. çok önemli hazırlıcam program için.

 

[emre311]

birde ben excel dosyasında tek tarih eklemiştim değişken olarak o iki ayrı hücrede tarih aralığındaki olacak bu yönle vba kod yazarsanız sevinirim.

 

[emre311]

yardım

yardım edecek kimse yokmu ?

 

[N.Ziya Hiçdurmaz]

yanıt

Bu şekil deneyiniz.

Sub aktar()
Dim sat As Integer
Dim s, ss As Integer
Dim bul As Object
Sayfa2.[a9:e100].Clear
s = 9
ss = 9
son = Sayfa1.Cells(Rows.Count, "a").End(xlUp).Row
Set bul = Sayfa1.Range("a2:a" & son).Find(Sayfa2.[b4], , xlValues, xlWhole)
    If Not bul Is Nothing Then
    adres = bul.Address
    Do
    If Sayfa1.Cells(bul.Row, "e") = Sayfa2.[b3] And Sayfa1.Cells(bul.Row, "b") = Sayfa2.[b5] Then
        Sayfa2.Cells(s, "a") = Sayfa1.Cells(bul.Row, "a")
        Sayfa2.Cells(s, "b") = Sayfa1.Cells(bul.Row, "b")
        Sayfa2.Cells(s, "c") = Sayfa1.Cells(bul.Row, "c")
        Sayfa2.Cells(s, "d") = Sayfa1.Cells(bul.Row, "d")
        Sayfa2.Cells(s, "e") = Format(Sayfa1.Cells(bul.Row, "e"), "dd.mm.yyyy")
        s = s + 1
    End If
    Set bul = Sayfa1.Range("a2:a" & son).FindNext(bul)
    Loop While Not bul Is Nothing And bul.Address <> adres
    End If
    '*****
    For sat = 2 To Sayfa1.Cells(Rows.Count, "a").End(xlUp).Row
        If Sayfa2.[b3] = "" And Sayfa2.[b4] = "" And Sayfa2.[b5] = "" Then
        Sayfa2.Cells(ss, "a") = Sayfa1.Cells(sat, "a")
        Sayfa2.Cells(ss, "b") = Sayfa1.Cells(sat, "b")
        Sayfa2.Cells(ss, "c") = Sayfa1.Cells(sat, "c")
        Sayfa2.Cells(ss, "d") = Sayfa1.Cells(sat, "d")
        Sayfa2.Cells(ss, "e") = Format(Sayfa1.Cells(bul.Row, "e"), "dd.mm.yyyy")
        ss = ss + 1
    End If
    Next
End Sub

 

[emre311]

Verdiğim örnek doyaya ekleyip gönderirmisiniz listele butonuna ekleyip size zahmet olcak ama yeni başlıyorum eksiklerim var teşeküürler şimdiden

 

[emre311]

run time eror 424 object required hatası veriyor bir türlü bulamadım.

Sub aktar()
Dim sat As Integer
Dim s, ss As Integer
Dim bul As Object
Kapak.[a23:n100].Clear
s = 23
ss = 23
son = Data.Cells(Rows.Count, "a").End(xlUp).Row
Set bul = Data.Range("a3:a" & son).Find(Kapak.[d16], , xlValues, xlWhole)
If Not bul Is Nothing Then
adres = bul.Address
Do
If Data.Cells(bul.Row, "j") = Kapak.[d19] Then
Kapak.Cells(s, "a") = Format(Data.Cells(bul.Row, "a"), "dd.mm.yyyy")
Kapak.Cells(s, "b") = Data.Cells(bul.Row, "b")
Kapak.Cells(s, "c") = Data.Cells(bul.Row, "c")
Kapak.Cells(s, "d") = Data.Cells(bul.Row, "d")
Kapak.Cells(s, "e") = Data.Cells(bul.Row, "e")
Kapak.Cells(s, "f") = Data.Cells(bul.Row, "f")
Kapak.Cells(s, "g") = Data.Cells(bul.Row, "g")
Kapak.Cells(s, "h") = Data.Cells(bul.Row, "h")
Kapak.Cells(s, "ı") = Data.Cells(bul.Row, "ı")
Kapak.Cells(s, "j") = Data.Cells(bul.Row, "j")
Kapak.Cells(s, "k") = Data.Cells(bul.Row, "k")
Kapak.Cells(s, "l") = Data.Cells(bul.Row, "l")
Kapak.Cells(s, "m") = Data.Cells(bul.Row, "m")
Kapak.Cells(s, "n") = Data.Cells(bul.Row, "n")
s = s + 1
End If
Set bul = Data.Range("a3:a" & son).FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> adres
End If
'*****
For sat = 2 To Data.Cells(Rows.Count, "a").End(xlUp).Row
If Kapak.[d16] = "" And Kapak.[d19] = "" Then
Kapak.Cells(s, "a") = Format(Data.Cells(bul.Row, "a"), "dd.mm.yyyy")
Kapak.Cells(s, "b") = Data.Cells(bul.Row, "b")
Kapak.Cells(s, "c") = Data.Cells(bul.Row, "c")
Kapak.Cells(s, "d") = Data.Cells(bul.Row, "d")
Kapak.Cells(s, "e") = Data.Cells(bul.Row, "e")
Kapak.Cells(s, "f") = Data.Cells(bul.Row, "f")
Kapak.Cells(s, "g") = Data.Cells(bul.Row, "g")
Kapak.Cells(s, "h") = Data.Cells(bul.Row, "h")
Kapak.Cells(s, "ı") = Data.Cells(bul.Row, "ı")
Kapak.Cells(s, "j") = Data.Cells(bul.Row, "j")
Kapak.Cells(s, "k") = Data.Cells(bul.Row, "k")
Kapak.Cells(s, "l") = Data.Cells(bul.Row, "l")
Kapak.Cells(s, "m") = Data.Cells(bul.Row, "m")
Kapak.Cells(s, "n") = Data.Cells(bul.Row, "n")
ss = ss + 1
End If
Next
End Sub

 

[bkrygt]

Acil yardım lütfen

Sn. N.Ziya Hiçdurmaz

Benim bir fiyat listesi hazırlamam lazım ancak bu liste otomatik bir liste olmalı
şöyleki;
Bir tane Fiyat listesi adlı çalışma kitabı hazırlayacağım.
bir tanede veriler adlı bir çalışma kitabı oluşturmam lazım
Bunları yaptıktan sonra
örnek
Fiyat listesi adlı çalışma kitabında;
A1'e "ald-1017a" gibi bir kod yazdığımda
A2 de ürünün resmi olacak (resim görüntüsü bozulmatan kutucuğun boyuna göre tam sığacak)
a3 te ürünün adı olacak
a4 te ürünün özellikleri olarak
a5 te ürünün açıklaması olacak
a6 da rengi olacak
a7 de birim fiyatı olacak

bu bilgileri ise ben ben kendim tek tek veriler adlı listede şu şekilde hazırlamak istiyorum
a sütünundaki hücrelere kodları
b sütunundaki hücrelere resimleri
c sütunundaki hücrelere ürünlerin adlarını
d sütunundaki hücrelere özelliklerini
e sütunundaki hücrelere renklerini
f sütunundaki hücrelere birim fiyatlarını girmek istiyorum.

bu işlemlerdne sonra oluşturduğuğum herhangi bir fiyat listesini müşteriye gönderdiğimde veriler dosyasındanda bağımsız çalışabilsin. ve resimler olduğu gibi kalsın.
Çok önemli olamayan birşey daha; mümkünse farklı kaydet yaptıktan sonra kodlar farklı kaydedilen dosyada olmasın.

bkrygt@hotmail.com
Lütfen yardımcı olun...