• DİKKAT

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

2 dosya arasında koşullu veri aktarımı

  • Konbuyu başlatan Konbuyu başlatan Metin_S
  • Başlangıç tarihi Başlangıç tarihi
Evren Gizlen merhaba, biliyorum çok oluyorum ama :) son birşey rica edicem. Tablo dosyasının açıklamalı son halini ekliyorum bakabilirsen sevinirim. Şimdiden teşekkür ederim.
Dosyanız ektedir.:cool:
 

Ekli dosyalar

Evren bu yaptığın I2 hücresindeki kodu değiştirince bilginin otomatik gelmesi buda çok güzel olmuş hatta çok daha iyi olmuş. Fakat, benim söylemek istediğim Tablo dosyasında R sütunundaki kod listesinin "Liste" dosyasındaki kod türlerine göre otomatik gelmesiydi.
 
Evren bu yaptığın I2 hücresindeki kodu değiştirince bilginin otomatik gelmesi buda çok güzel olmuş hatta çok daha iyi olmuş. Fakat, benim söylemek istediğim Tablo dosyasında R sütunundaki kod listesinin "Liste" dosyasındaki kod türlerine göre otomatik gelmesiydi.
Dosaynız ektedir.
Verilerin çokluğuna göre işklem uzayabilir.:cool:
Kod:
Sub kapali_dosya_aktar()
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim sat As Long, i As Byte, sat2 As Long
'Tools referenceden Microsoft activex data object 2.8 library seçildi
Sheets("Sheet1").Select
sat2 = Cells(65536, "R").End(xlUp).Row
If sat2 < 2 Then
    MsgBox "R sütunda Kod yok.Arama yapılmadı.", vbCritical, "UYARI"
    Exit Sub
End If

Application.ScreenUpdating = False
sat = 2

Range("A2:D65536").ClearContents
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "Provider=microsoft.jet.oledb.4.0;data source= " & ThisWorkbook.Path & "\Liste.xls;extended properties=""excel 8.0;hdr=yes"""
rs.Open "Select * from [Sheet1$] kod order by Adı;", conn, adOpenKeyset, adLockReadOnly
If rs.RecordCount > 65534 Then
    MsgBox "çok sayıda veri var sayfaya sığmayacağından dolayı veri aktarılmadı", vbCritical, "UYARI"
    GoTo atla
End If

If rs.RecordCount > 0 Then
    rs.MoveFirst
    Do While Not rs.EOF
        If WorksheetFunction.CountIf(Range("R2:R" & sat2), rs("kod").Value) > 0 Then
            Cells(sat, "A").Value = rs("Sıra").Value
            Cells(sat, "B").Value = rs("SeriNo").Value
            Cells(sat, "C").Value = rs("Adı").Value
            Cells(sat, "D").Value = rs("Türü").Value
            sat = sat + 1
        End If
    rs.MoveNext
    Loop
    Application.ScreenUpdating = True
    MsgBox "Aktarım yapıldı." & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
    Else
    Application.ScreenUpdating = True
End If
atla:
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub
 

Ekli dosyalar

Evren özür dilerim tam anlatamadım galiba. Daha önce yaptıklarımızı unut bu başka birşey. Biraz detaylı anlatmaya çalışayım. Liste dosyasında bulunan kodların her birinden 1 tane olmak şartıyla kodlar Tablo dosyasındaki Kod Listesine otomatik gelecek. Örneğin; Listede 1-2-3-4-44-55 vb gibi kodlar varsa bunlar Tablo dosyasındaki kod Listesine sıralı bir şekilde yukarıdan aşağıya doğru otomatik gelecek.
 
Bu arada farkettğim birşey oldu. Listeden aldığımız bilgiler SeriNo sütünundaki bilgiye göre küçükten büyüğe doğru sıralı olabilirmi
 
sıralama sorununu çözdüm " order by SeriNo;" yaparak sıralam düzeldi. Sadece kod listesinin otomatik gelmesi kaldı :)
 
Sıralama olmadı şöyle bir sorun çıktı 1198 önce 121 sonra geldi. Nasıl sıraladı anlamadım.
 
Kod Listesi

Evren merhaba,

Sıralama sorununu çözdüm. Dosyaların düzenlenmiş ve açıklamalı halini ekliyorum. Kod listesi otomatik geldimi tamamdır bu iş sana zahmet oluyor şimdiden çok teşekkür ederim.
 

Ekli dosyalar

Hata

Evren Gizlen merhaba, yazdığın kodları asıl dosyalarımda kullanmak istediğimde içinde harf veya farklı işaretler (/ -) olanlarda hata veriyor. Örnek dosya ektedir. Bakabilirsen çok sevinirim.
 

Ekli dosyalar

Sayın Metin_S ne gibi bir hata mesajı veriyor?
 
hata

Evren bey merhaba,

Liste dosyasında bulunan kodlar sütununda bulunan kodun içinde harf veya işaretler olunca hata veriyor ekran görüntüsünü ekliyorum.
 

Ekli dosyalar

  • tablo_hata.jpg
    tablo_hata.jpg
    96 KB · Görüntüleme: 7
Son düzenleme:
Evren bey merhaba,

Hata ekranını 31.mesajda resim olarak eklemiştim. Müsait olduğunuz bir zamanda bakabilirseniz çok sevinirim. Şimdiden teşekkür ederim.
 
Evren bey merhaba,

Hata ekranını 31.mesajda resim olarak eklemiştim. Müsait olduğunuz bir zamanda bakabilirseniz çok sevinirim. Şimdiden teşekkür ederim.
I2 hücresinin içinde ne vardı.Dosya ismi ,sayfa ismi falanmı vardı.Veya sütun başlığımı vardı?
Ne vardı?
 
Hata

Evren bey, I2 hücresine "Liste" dosyasındaki Kod sütununu kontrol ettirip oradaki bilgileri getiriyorduk. Dosyanın son halini ekliyorum, sağolun.
 

Ekli dosyalar

Liste sayfasında kod alanını nümeric olarak kabul ediyor.
Oysa siz string değer giriyorsunuz ve o sebepten kabul etmiyor.
O zaman kod alanına (liste dosyasında) hep strin grin.
Kod olarak gireceiniz sayısal değerlerin başına ' tek kesme koyunuz.Ben yaptım ekte yolluyorum.Liste sayfasında kod alanını inceleyiniz.:cool:
Şimdi çalışıyor.:cool.
Kod:
rs.Open "Select * from [Sheet1$] where kod =[B][COLOR="Red"][SIZE="4"]'[/SIZE][/COLOR][/B]" & Range("I2").Value & "[B][COLOR="Red"][SIZE="4"]'[/SIZE][/COLOR][/B] order by SeriNo;", conn, adOpenKeyset, adLockReadOnly
 

Ekli dosyalar

Sayın EVREN GİZLEN,

Sorun düzeldi. Benim için çok önemli ve büyük değeri olan bu yardımlarınız için çok teşekkür ederim. Herşey gönlünüzce olsun.

Saygılarımla.
 
Sayın EVREN GİZLEN,

Sorun düzeldi. Benim için çok önemli ve büyük değeri olan bu yardımlarınız için çok teşekkür ederim. Herşey gönlünüzce olsun.

Saygılarımla.
Rica ederim.
İyi çalışmalar.
Not:Bu arada avatarınızıda çok beğendim.Böyle içi Atatürk sevgisi ile dolu insanları görünce bu toz dumanda insanın içi biraz olsun ferahlıyor.
 
Siz hiç merak etmeyin içinde Atatürk sevgisi olan çok insanımız var. Biz millet olarak ne toz duman ortamlardan geçtik. Atatürk'ün yaptıklarından birazda olsa ders alsalar bugün bu hallerde olmazdık. İlginize çok teşekkür ederim. İyi günler diliyorum.
 
merhabalar,
bu konu ile ilgili olarak sadece I2 hücresine değilde I kolonundaki hücrelere değer girildikçe diger bilgileri getirmemiz mümkünmü?
örnek olarak I2=1 iken degerlerini getirsin,
I3 'e bir değer girdiğimde degerini getirsin, bu işlem bir döngü içinde yapılabilirmi?
birde hücreye giriş yapıldıktan sonra komut çalışsın gibi bir komut var mı?
desteğiniz için teşekkürler.
 
Geri
Üst