Dosyadan veri çagırmak ve başka bir dosyada ilgili yere yazmak

[enmer]

Ekde bulunan teklif formund kodu bölümündeki hücrelere kod yazıldığında fiyat marka ve özellikleri çekmeyi daha önce yine sizlerin yardımıyla düşeyara formülüyle yapmıştık yanlız bu durumda kodu tam ve eksiksiz gimemiz gerekiyor 30000 ürün çeşidimiz olması kodları eksiksiz girmemizi egelliyor. Sizlerden ricam teklif formuna bir buton koyup butona tıkladıgımızda fiyalar bölümündeki liste çıkması ve bu listeden secim yaptıgımda busecimin teklifler kısmında ilgili yerlere verilerinin girilmesi. forumdaki araştırmalarımda bunu kayar menüyle yapmışlar yanlız 30000 ürün bu menüye sıgdırmak imkansız ve bul komutuda çalışmayacaktır. Bunun sadece makroyla yapılabilecegini düşündügüm için kunuyu buraya açıyorum. Yardımlarınız için şimdiden teşşekür ederim. Daha önce birçok konuda yine sizlerden yardım aldım onlar içinde tekrar teşekkür etmek istiyorum iyi çalışmalar...

 

[Orion1]

Dosyanız ektedir.

Private Sub CommandButton1_Click()
Dim deg As String, koda As String
Dim myarr(), sat As Long, i As Long, strsat As String, a As Long
ListBox1.Clear
ListBox1.ColumnCount = 4
sat = Application.ExecuteExcel4Macro("COUNTA('" & ThisWorkbook.Path & _
"\[fiyatlar2.xls]liste'!C1)") + 1
strsat = "'" & ThisWorkbook.Path & _
"\[fiyatlar2.xls]liste'!R"
ReDim myarr(1 To 4, 2 To sat)
a = 1
For i = 2 To sat
    koda = CStr(Application.ExecuteExcel4Macro(strsat & i & "C2"))
    koda = UCase(Replace(Replace(koda, "ı", "I"), "i", "İ"))
    If TextBox1.Text = "" Then
        deg = koda
        Else
        deg = UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ"))
    End If
    If koda Like "*" & deg & "*" Then
        a = a + 1
        myarr(1, a) = Application.ExecuteExcel4Macro(strsat & i & "C4")
        myarr(2, a) = Application.ExecuteExcel4Macro(strsat & i & "C1")
        myarr(3, a) = koda
        myarr(4, a) = Application.ExecuteExcel4Macro(strsat & i & "C3")
    End If
Next i
If a > 1 Then
    ReDim Preserve myarr(1 To 4, 2 To a)
    ListBox1.Column = myarr
End If
Me.Label1.Caption = "Listelenen : " & Format(ListBox1.ListCount - 2, "#,##0")
End Sub

Private Sub Label1_Click()

End Sub

Private Sub ListBox1_Click()
Dim sat As Long
If ListBox1.ListCount < 1 Then Exit Sub
sat = Cells(65536, "B").End(xlUp).Row + 1
If sat > 65533 Then
    MsgBox "Sayfada satır doldu.Kayıt girilmedi.", vbCritical, "UYARI"
    Exit Sub
End If
Cells(sat, "A").Select
Cells(sat, "B").Value = ListBox1.Column(0)
Cells(sat, "E").Value = ListBox1.Column(1)
Cells(sat, "G").Value = ListBox1.Column(2)
On Error Resume Next
Cells(sat, "L").Value = CDbl(ListBox1.Column(3))
End Sub

 

[enmer]

Merhaba Evren bey. ilgilendiğiniz için çok teşekkür ediyorum yanlız butona bastıgımda dosya kitleniyor ve hiç birşey açılmıyor. kapata bas diyorum Sonra hata mesajı çıkıyor. automations error diyor

 

[Orion1]

Merhaba Evren bey. ilgilendiğiniz için çok teşekkür ediyorum yanlız butona bastıgımda dosya kitleniyor ve hiç birşey açılmıyor. kapata bas diyorum Sonra hata mesajı çıkıyor. automations error diyor

Benim size yolladığım dosya bende sorunsuz çalışıyordu.Hiç bir problem yoktu.

 

[enmer]

Evren bey sorunu ancak çöze bildim iki dosyayıda açmak gerekiyormuş sadece teklif dosyasını açıp butona tıkladığımızda hata veriyor sanırım ikisni açmak mecburiyetindeyiz cahilliğime verin emeginizden dolayı çok teşekkür ederim sizen bir ricam daha olacak bu userforumaç butonuna tıkladıgmızda çıkan listede 30000 üzeri kod olacak bu yüzden oraya bul butonu koymamız mümkünmüdür zira ctrl-f çalışmıyor orada. Açılan forumda bul butonuda olursa tam anlamıyla harika olacak yardımlarınızdan dolayı tekrar teşekkür ederim.

 

[Orion1]

Evren bey sorunu ancak çöze bildim iki dosyayıda açmak gerekiyormuş sadece teklif dosyasını açıp butona tıkladığımızda hata veriyor sanırım ikisni açmak mecburiyetindeyiz cahilliğime verin emeginizden dolayı çok teşekkür ederim sizen bir ricam daha olacak bu userforumaç butonuna tıkladıgmızda çıkan listede 30000 üzeri kod olacak bu yüzden oraya bul butonu koymamız mümkünmüdür zira ctrl-f çalışmıyor orada. Açılan forumda bul butonuda olursa tam anlamıyla harika olacak yardımlarınızdan dolayı tekrar teşekkür ederim.

Hayır .Diğer dosyanız açık olması gerekmiyor.
Kapalı ikende çalışması lazım.
Bu dediğiniz üzre şimdi çalıştırdım,problemsiz gayet iyi çalışıyor.2 dosyanın da ayni klasör içinde olamsı lazım
Diğer konuyu tam açıklarsanız yaparım.Bul neyi bulacak?
Kaynak dosyadaki hangi sütunda arama yapılacak?
Direk onu arayarak bulduklarını listeleyebiliriz.

 

[enmer]

Evren bey kaynak dosyada 2. sütünda arama yapacak yani kod bölümünde ben fiyatlar dosyasını tekrar yükledim eski dosya eksikmiş yeni fark ettim teklif dosyayında sırası ile marka açıklama kod ve fiyatları ilgili sütünlara yazacak yani B10,E10,G10 VE L10 Hücrelerine

Özetleyecek olursak;

Ben teklif dosyayısı açtıgımda butona tıklıcam sonra çıkan listede arama bölümünde kodun bir kısmını yazıcam sonra kodu bulup seçtigimde teklif dosyasında istediğim marka, açıklama, kod, ve fiyat bölümleri otomatik gelecek.

Teşekkür ederim..

 

[Orion1]

Evren bey kaynak dosyada 2. sütünda arama yapacak yani kod bölümünde ben fiyatlar dosyasını tekrar yükledim eski dosya eksikmiş yeni fark ettim teklif dosyayında sırası ile marka açıklama kod ve fiyatları ilgili sütünlara yazacak yani B10,E10,G10 VE L10 Hücrelerine

Özetleyecek olursak;

Ben teklif dosyayısı açtıgımda butona tıklıcam sonra çıkan listede arama bölümünde kodun bir kısmını yazıcam sonra kodu bulup seçtigimde teklif dosyasında istediğim marka, açıklama, kod, ve fiyat bölümleri otomatik gelecek.

Teşekkür ederim..

Dosyanız ektedir.
Diğer konuda dosya kapalı iken çalışmıyor demiştiniz.Çalışması lazım.O konuda bir şey dememişsiniz.
Dosyayı önceki yerinden indirebilirsiniz.

 

[enmer]

Merhaba Evren bey dosya inanılmaz güzel olmuş bul işini harika yapıyor yanlız eski problem bende biraz değişik bir şekilde hala devam ediyor. Önceden userformu aç dediğimde dosya kitleniyordu şimdi kitlenmiyor aç dedigimde bul sayfası açılıyor fakat kodun bir kısmını yazıp ara dedigimde dosya kitleniyor ve program yanıt vermiyor kapatmak zorunda kalıyorum. iki dosyada açıkken bir sorun yaşanmıyor.

Evrenbey dosyayı kullanmaya başladım kullanınca bir eksiklik fark ettim teklif dosyasında ürünler alt alta sıralnıyor her seferinde yeni ürün en alta atılıyor fakat aradan bir taneyi değiştirmek istedigimizde buna müsade etmiyor yani arda bir boşluk olsada yine program yeni kodu en alta atıyor. bu düzeltilebilinecek bir sorunmudur yoksa böyle kullanmamızmı gerekir yada araya satır ekle dedigimde o satıra bir kodu listeden çekmek için özel bişiy mi yapmam gerekiyor zira ben satırda bütü hücreleri tek tek seçip denedim ama bir türlü araya yeni ürünü giremedim veya arada kalan bir ürünün kodunu değiştiremedim. Ürün bul bölümünde ise ürün üzerine tek tıklamada ürünü hemen yerleştiriyor iki tıklama ile olması daha iyi olacak gibi düşünüyorum kullanırken sorun çıkartıyor ürün gamı çok büyük oldugundan yanlışlıkla bir ürüne tek tık yapmak çok olası bu sorunu kendim halletmeye çalışacagım umarım basit bişeydir başınızı çok ağrıttım kusura bakmayın.



Ellerinize sağlık teşekkür ederim.

 

[Orion1]

Merhaba Evren bey dosya inanılmaz güzel olmuş bul işini harika yapıyor yanlız eski problem bende biraz değişik bir şekilde hala devam ediyor. Önceden userformu aç dediğimde dosya kitleniyordu şimdi kitlenmiyor aç dedigimde bul sayfası açılıyor fakat kodun bir kısmını yazıp ara dedigimde dosya kitleniyor ve program yanıt vermiyor kapatmak zorunda kalıyorum. iki dosyada açıkken bir sorun yaşanmıyor.

Evrenbey dosyayı kullanmaya başladım kullanınca bir eksiklik fark ettim teklif dosyasında ürünler alt alta sıralnıyor her seferinde yeni ürün en alta atılıyor fakat aradan bir taneyi değiştirmek istedigimizde buna müsade etmiyor yani arda bir boşluk olsada yine program yeni kodu en alta atıyor. bu düzeltilebilinecek bir sorunmudur yoksa böyle kullanmamızmı gerekir yada araya satır ekle dedigimde o satıra bir kodu listeden çekmek için özel bişiy mi yapmam gerekiyor zira ben satırda bütü hücreleri tek tek seçip denedim ama bir türlü araya yeni ürünü giremedim veya arada kalan bir ürünün kodunu değiştiremedim. Ürün bul bölümünde ise ürün üzerine tek tıklamada ürünü hemen yerleştiriyor iki tıklama ile olması daha iyi olacak gibi düşünüyorum kullanırken sorun çıkartıyor ürün gamı çok büyük oldugundan yanlışlıkla bir ürüne tek tık yapmak çok olası bu sorunu kendim halletmeye çalışacagım umarım basit bişeydir başınızı çok ağrıttım kusura bakmayın.



Ellerinize sağlık teşekkür ederim.

Araya yazma yapmaz.Ben kodu en son satıra yazılması şeklinde ayarladım.
Excelde vba için kod yazmak için bazı kabuller yapmak zorundasınız.Ben kabul terciğimi en çok kullanılşan ve kullanışlı olan taraftan yana yaptım.
Satır aralarına giriş yapmak için kodda ufak bir değişiklik yapmak lazım.Ama bu sizin için tehklikeli olur.
Satır arasına kayıt girmeniz için önce kayıt girileck satırı seçmenizi isteuyecem.
Yanlış bir satır seçerseniz verile oraya girecek daha önce girilmiş veri varsa onun üstüne yazılacak
Buda veri kaybı olur.
Ayriyetten her yeni veri girişinde en son satır manuel siz seçmeniz gerekecek yanlış seçim yine ayni şeyi doğrur.
Gelelim diğer konuya.dosya kapalı iken verielri alamıyor demişsiniz.
Sanırım bu excel4makro da olan bir sıkıntı.Excel 4 makro kullanmıştım.
Şimdi kodları değiştirdim.ADO ile verileri aldım.
BBu durumda diğe dosya kapalı iken sorun çıkarmaz.
Yalnız ilk satıra satır başlıkları verdim.a-b-c-d diye
onları silmemelisiniz
daima ilk satırda ayni sırada olmalılar.
Ayrıca bu yeni yazdığım kat diğerinden çok daha hızlı çalışacaktır.
Dosyanız ektedir.

Private Sub ara_bul_59()
Dim conn As ADODB.Connection, rs As ADODB.Recordset, deg As String
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
deg = UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ"))
ListBox1.Clear
conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\fiyatlar2.xls;extended properties=""excel 8.0;hdr=yes"""
rs.Open "select d,a,b,c from [liste$A1:D65536] where b like '%" & deg & "%';", conn, adOpenKeyset, adLockReadOnly
If rs.RecordCount > 0 Then ListBox1.Column = rs.GetRows
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim sat As Long
If ListBox1.ListCount < 1 Then Exit Sub
sat = Cells(65536, "B").End(xlUp).Row + 1
If sat > 65533 Then
    MsgBox "Sayfada satır doldu.Kayıt girilmedi.", vbCritical, "UYARI"
    Exit Sub
End If
Cells(sat, "A").Select
Cells(sat, "B").Value = ListBox1.Column(0)
Cells(sat, "E").Value = ListBox1.Column(1)
Cells(sat, "G").Value = ListBox1.Column(2)
On Error Resume Next
Cells(sat, "L").Value = CDbl(ListBox1.Column(3))
End Sub

 

[enmer]

Evren bey herşey mükemmel çalışıyor yardımlarınız için çok çok teşekkürederim ellerinize sağlık. Kullanmaya başladım ve artık çok daha hızlı çalışabiliyorum.

saygılar... sevgiler...

 

[Orion1]

Evren bey herşey mükemmel çalışıyor yardımlarınız için çok çok teşekkürederim ellerinize sağlık. Kullanmaya başladım ve artık çok daha hızlı çalışabiliyorum.

saygılar... sevgiler...

Rica ederim.
İyi çalışmalar.

 

[Orion1]

Çift tıklama olayını unutmuşum.
Dosyayı tekrar düzenledim.
10ncu mesajdan indirebilirsiniz.

 

[enmer]

bir konuda daha yardımınızı rica edebilirmiyim

Evren bey merhaba yazmış oldugnuz kodlarla formumu kullanmaya başladım işimi inanılmaz kolaylaştırdı sizden bir konuda daha yardım rica edicem ben sizin bu yaptıklarınızı örnek alarak yapmaya çalışıyorum am malumunuz 1 haftadır ugraşıyorum beceremedim. bu yaptıgınız sistemi ekte bulunun dosyada aynı teklifn kapak sayfası mevcut birde müşteriler dosyası kapak sayfasındaki kırmızı logoya tıkladıgımızda (diger gönderdiginiz dosyayıda öyle yaptım) yine bul sayfası çıksa ve oradan müşteri firma ismine göre arama yaptıgımızda firmayı secsek ve ilgili yerlere otomatik gelse yaptıgımız dosyadaki işlemin aynısı fakat burada ürünler degil firma isimleri gelecek
yardımlarınız için şimdiden çok teşekkür ediyorum evren bey

 

[enmer]

Evren bey çift tıklama olayı içinde ayrıca teşekkür ederim

 

[enmer]

Yardımcı olabilcek kimse yokmudur ?