Veri aktarma.

[Bora K]

Evet güzel fikir. Ama şuanda alternatif olarak düşünülebilir ancak.
"Olmayacak iş dünyaya gelmezmiş" derler. Biraz bekleyelim. En son
merhalede teati edebiliriz ancak.

İlginiz ve gayretiniz için çok teşekkür ederim
Sayın Asi Kral.

 

[Bora K]

Sana farklı bir fikir.
2 tane klasör açın. 1'inin içinde tüm dosyalarınız olsun. 2'incisinin içinde ise veri eklenecek dosyalar olsun.
Siz 2 dosyaya eklenecek dosyaları getirin kodla içine verileri ekleyelim sonra o dosyaları tüm dosyalar klasörüne alın. Böylece 2000 tane dosyadan 20 - 30 - 40 yada 100 tane dosyayı kontrol ettirmiş oluruz.

Günaydın;
Sayın Asi Kral.
Bu öneriniz doğrultusunda. Yardımınızı
talep ediyorum.

Eki tekrardan güncelledim. Eksik birşey bırakmamak
adına. Müsait olduğunuz zamanda bakabilirseniz sevinirim.

 

[asi_kral]

Merhaba
Şunu sormak istiyorum. Bu kodlardan başka dosyada olmayacak değil mi_?
Yani 1 tane Kapalı 1 2 tane Kapalı 2'de olmayacak. Hep aynı dosyanın içinde olacak.

 

[Bora K]

Biraz daha detaylı yazarmısınız lütfen.
Makroyu ona göremi şekillendireceksiniz? Yanlış malumat
verip zamanınızı boşa harcamayalım.

 

[asi_kral]

Biraz daha detaylı yazarmısınız lütfen.
Makroyu ona göremi şekillendireceksiniz? Yanlış malumat
verip zamanınızı boşa harcamayalım.

Yani A verisi Kapalı 1 dosyasında 2 adet olduğunu düşünelim.
Gene A verisi Kapalı 2 dosyasında olacak mı_?
Olacaksa aynı verileri mi kaydedecek.
Olamayacaksa zaten problem yok.

 

[Bora K]

Evet üstad 2 adet olması
Diğer dosyada olmasına mani olmayacak.
Şartlar sağlanıyor ise
Bir veri 2 farklı dosyayada yazılabilecek.
Aynı veriler gidecek evet.

 

[asi_kral]

Evet üstad 2 adet olması
Diğer dosyada olmasına mani olmayacak.
Şartlar sağlanıyor ise
Bir veri 2 farklı dosyayada yazılabilecek.
Aynı veriler gidecek evet.

Kodu yazmaya başlamadan şunu da sorayım.
Bu listedeki tüm kayıtlar mı gidecek yoksa. Belli bir şart var mı_?
Seçtiğiniz yada bir işaretle belirlediğiniz bir şart mevcut mu_?

 

[Bora K]

Merhaba

"Yeni Gelenler" dosyası liste dosyası.
Buraya konulan veriler kapalılara aktarılmak için konulyor.
Eğer ilgili kriterler sağlanırsa şayet tamamı gidecek.
Örnek dosyada izah ettiğim gibi.

Yeşil renkli verileri göndereceğiz. Bu veriler gitmesi için.
Karışsındaki kahverengi değerleri kapalılarda bulması lazım.
Şayet bulamazsa doğal olarak gidemeyecek.
Herhangi bir işaret falan olmayacak.
Az önce bahsettiğim gibi tek şart. Kahverengi verilerin
kapalılarda olması. Varsa gidecek.

 

[asi_kral]

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub veri_aktar()
Dim XCL As Application, KTP As Workbook, S1 As Worksheet
Dim S2 As Worksheet, STR As Long, BUL As Range, SBT As Variant
Dim DSY As String, YOL As String, SY As Variant, STR1 As Long
Set XCL = CreateObject("Excel.Application")
XCL.Visible = False
Application.ScreenUpdating = False
YOL = ThisWorkbook.Path & "\"
Set S1 = ActiveSheet
For STR = 7 To S1.Cells(Rows.Count, "D").End(xlUp).Row
DSY = Dir(YOL & "*.xls?")
Do While DSY <> Empty
If DSY <> ActiveWorkbook.Name Then
Set KTP = XCL.Workbooks.Open(YOL & DSY)
Set S2 = KTP.ActiveSheet
STR1 = S2.Range("D" & Rows.Count).End(xlUp).Row
S2.Range("D5:F" & STR1).AutoFilter 1, S1.Cells(STR, "D")
S2.Range("D5:F" & STR1).AutoFilter 3, S1.Cells(STR, "F")
S2.Range("M1") = "=SUBTOTAL(3,D7:D" & STR1 & ")"
SY = S2.Range("M1"): S2.Range("M1") = Empty
If SY > 0 Then
S2.Range("D7:F" & STR1).AutoFilter
Set BUL = S2.Range("D:D").Find(S1.Cells(STR, "D"), , , xlWhole)
If Not BUL Is Nothing Then
SBT = BUL.Address
Do
If S2.Cells(BUL.Row, "F") = S1.Cells(STR, "F") And _
S2.Cells(BUL.Row, "H") = Empty Then
S2.Cells(BUL.Row, "H") = S1.Cells(STR, "H")
S2.Cells(BUL.Row, "I") = S1.Cells(STR, "I")
S2.Cells(BUL.Row, "K") = S1.Cells(STR, "K")
S2.Cells(BUL.Row, "L") = S1.Cells(STR, "L")
S1.Cells(STR, "M") = "Gönderildi"
Exit Do
End If
Set BUL = S2.Range("D:D").FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> SBT
End If
Else
S2.Range("D7:F" & STR1).AutoFilter
S1.Cells(STR, "M") = "Gönderilmedi"
End If
KTP.Save: KTP.Close: XCL.Quit
End If: DSY = Dir
Loop
Next
Application.ScreenUpdating = True
End Sub

Dosya ekte.

 

[Bora K]

Merhaba
sn Asi Kral

Ellerinize sağlık kod gayet güzel olmuş an itibari ile.
"Yeni Gelenler" kitabında gönderilen verilerin yanına M sütununa
"gönderildi" yazılacaktı. Sanırım gözden kaçtı.
Bu ilaveyi yapabilirseniz sevinirm üstad.

 

[asi_kral]

Merhaba
sn Asi Kral

Ellerinize sağlık kod gayet güzel olmuş an itibari ile.
"Yeni Gelenler" kitabında gönderilen verilerin yanına M sütununa
"gönderildi" yazılacaktı. Sanırım gözden kaçtı.
Bu ilaveyi yapabilirseniz sevinirm üstad.

Üstteki kodu güncelledim.

 

[Bora K]

Tekrardan Merhaba.
Sn Asi Kral.

"gönderildi" yazısından sonra kodu orjinal dosyada deneme fırsatı buldum şimdi.
Aktarılmayan verilerin yanında ("gönderilmedi" yazısı olmasın lütfen.
Çünkü gitmeyen verilerde o hücreyi başka amaç için kullanacağım.)

Orjinal dosyaların çoğunluğunda sayfa adedi fazla olduğu için epey bir süre bekletiyor.
Kapalı dosyaların hepsinde verilerin yazılacağı sayfa adı "Data" sayfasıdır.
Koda "Data" sayfalarında ara derseniz sanırım arama kısa sürecektir.

Şu anda arama uzun sürdüğü için kodu tam anlamı ile inceleyemeyiorm.
Bold yazı ile belirttiğim 2 değişikliği yaparsanız kodu tekrar deneyeceğim.

Teşekkür ederim.

 

[Bora K]

Üstad yukarıda yazdıklarıma ilave olarak.

Kapalılara yeni bir dosya eklendiğinde şunu yapıyor.
Hepsine verisini gönderiyor verilerde sorun yok.
Lakin "gönderildi" ibaresini sadece en son eklenen dosyanın verisine yazıyor.

 

[asi_kral]

Üstad yukarıda yazdıklarıma ilave olarak.

Kapalılara yeni bir dosya eklendiğinde şunu yapıyor.
Hepsine verisini gönderiyor verilerde sorun yok.
Lakin "gönderildi" ibaresini sadece en son eklenen dosyanın verisine yazıyor.

Burada anlatmak istediğinizi anlamadım.
Lütfen detay verir misiniz_?
Sayfayı Data'ya çevirdim. Ayrıca Sadece gönderildi yazıyor.

Option Explicit
Sub veri_aktar()
Dim XCL As Application, KTP As Workbook, S1 As Worksheet
Dim S2 As Worksheet, STR As Long, BUL As Range, SBT As Variant
Dim DSY As String, YOL As String, SY As Variant, STR1 As Long
Set XCL = CreateObject("Excel.Application")
XCL.Visible = False
Application.ScreenUpdating = False
YOL = ThisWorkbook.Path & "\"
Set S1 = ActiveSheet
For STR = 7 To S1.Cells(Rows.Count, "D").End(xlUp).Row
DSY = Dir(YOL & "*.xls?")
Do While DSY <> Empty
If DSY <> ActiveWorkbook.Name Then
Set KTP = XCL.Workbooks.Open(YOL & DSY)
Set S2 = KTP.Sheets("Data")
STR1 = S2.Range("D" & Rows.Count).End(xlUp).Row
S2.Range("D5:F" & STR1).AutoFilter 1, S1.Cells(STR, "D")
S2.Range("D5:F" & STR1).AutoFilter 3, S1.Cells(STR, "F")
S2.Range("M1") = "=SUBTOTAL(3,D7:D" & STR1 & ")"
SY = S2.Range("M1"): S2.Range("M1") = Empty
If SY > 0 Then
S2.Range("D7:F" & STR1).AutoFilter
Set BUL = S2.Range("D:D").Find(S1.Cells(STR, "D"), , , xlWhole)
If Not BUL Is Nothing Then
SBT = BUL.Address
Do
If S2.Cells(BUL.Row, "F") = S1.Cells(STR, "F") And _
S2.Cells(BUL.Row, "H") = Empty Then
S2.Cells(BUL.Row, "H") = S1.Cells(STR, "H")
S2.Cells(BUL.Row, "I") = S1.Cells(STR, "I")
S2.Cells(BUL.Row, "K") = S1.Cells(STR, "K")
S2.Cells(BUL.Row, "L") = S1.Cells(STR, "L")
S1.Cells(STR, "M") = "Gönderildi"
Exit Do
End If
Set BUL = S2.Range("D:D").FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> SBT
End If
Else
S2.Range("D7:F" & STR1).AutoFilter
End If
KTP.Save: KTP.Close: XCL.Quit
End If: DSY = Dir
Loop
Next
Application.ScreenUpdating = True
End Sub

 

[Bora K]

Sn Asi Kral
Örnek kapalı dosyamız 2 adet idi. Ben ilk denememde.
Her iki kapalı dosyaya gönderilen verilerin yanına gönderildi yazdı.
klasörün içine orjinal dosyamdan bir tane koydum.
Hepsine verisini gönderdi sadece orjinal dosyama gönderilen verinin yanına gönderildi yazdı.
Boş bir kitap oluşturdum onuda klasörürn içine attım (4. kapalı) bu kez de
en son koyduğum dosyaya gönderilen verinin yanına gönderildi yazdı.
Veri göndermede sıkıntı yok. Sadece bir tane dosyaya gönderilen verinin yanına "gönderildi" yazıyor gibi
düşünün. Umarım anlatabildim

 

[Bora K]

Üstad ; üstteki yazdığım hata olmadı son makroda.

Lakin çok geç yazıyor, çok bekletiyor yazarken.
Ne yapabiliriz acaba? Bir alternatif üretebilirmisiniz.

 

[asi_kral]

Sn Asi Kral
Örnek kapalı dosyamız 2 adet idi. Ben ilk denememde.
Her iki kapalı dosyaya gönderilen verilerin yanına gönderildi yazdı.
klasörün içine orjinal dosyamdan bir tane koydum.
Hepsine verisini gönderdi sadece orjinal dosyama gönderilen verinin yanına gönderildi yazdı.
Boş bir kitap oluşturdum onuda klasörürn içine attım (4. kapalı) bu kez de
en son koyduğum dosyaya gönderilen verinin yanına gönderildi yazdı.
Veri göndermede sıkıntı yok. Sadece bir tane dosyaya gönderilen verinin yanına "gönderildi" yazıyor gibi
düşünün. Umarım anlatabildim

Aslında öyle değil ama. Her kayıt yaptığında hücreye aynı yazıyı yazdığı için size öyle geliyor. Dilerseniz Dosya adını yazdırayım hangi dosyaya yazdığını görün.

 

[asi_kral]

Üstad ; üstteki yazdığım hata olmadı son makroda.

Lakin çok geç yazıyor, çok bekletiyor yazarken.
Ne yapabiliriz acaba? Bir alternatif üretebilirmisiniz.

Sebebi büyük bir ihtimalle aynı dosyanın içinde 1'den fazla aynı veri olduğu için onun boş olanını bulmaya çalışıyor ondan kaynaklanan bir durum olmalı.
Ben şu an ölçtüm. 2 dosyaya kayıt yaptığında 5 saniye sürdü

 

[Bora K]

Aslında öyle değil ama. Her kayıt yaptığında hücreye aynı yazıyı yazdığı için size öyle geliyor. Dilerseniz Dosya adını yazdırayım hangi dosyaya yazdığını görün.

Yok üstad söyledğim gibi son makroda zaten normale döndü.

Sebebi büyük bir ihtimalle aynı dosyanın içinde 1'den fazla aynı veri olduğu için onun boş olanını bulmaya çalışıyor ondan kaynaklanan bir durum olmalı.

Bu dediğinizi tam olarak anlayamadım. D ve F sütunundan mı bahsediyorsunuz.?


Aktarma sırasında klasörün içinde aşağdaki simge oluşuyor. Aktarma
bittikten sonra simge kayboluyor. Sanırım kod aktarılacak verilerle sayfayı yeniden kayıt ediyor.
Yada ben öyle anladım. Sadece fikir benimkisi.
Benim orjinal dosyalar 10 mb civarında ortalama olarak. Dolayısı ile aktarma uzun sürüyor.
Dahası ben tek dosya ile deneme yapıyorum. Dosya sayısı çoğaldığında
düşünemiyorum ne kadar bekleyeceğimi

[/IMG]

 

[asi_kral]

Yok üstad söyledğim gibi son makroda zaten normale döndü.


Bu dediğinizi tam olarak anlayamadım. D ve F sütunundan mı bahsediyorsunuz.?


Aktarma sırasında klasörün içinde aşağdaki simge oluşuyor. Aktarma
bittikten sonra simge kayboluyor. Sanırım kod aktarılacak verilerle sayfayı yeniden kayıt ediyor.
Yada ben öyle anladım. Sadece fikir benimkisi.
Benim orjinal dosyalar 10 mb civarında ortalama olarak. Dolayısı ile aktarma uzun sürüyor.
Dahası ben tek dosya ile deneme yapıyorum. Dosya sayısı çoğaldığında
düşünemiyorum ne kadar bekleyeceğimi

[/IMG]

Kayıt işlemi yaptığı için o işaret çıkıyor.
O zaman bu süre sizin dosyanızı arka planda çalıştırıp bakmasından kaynaklanıyor. Uzun zaman alması bunu nasıl önlersiniz onu bilemem. Ben sizin gönderdiğiniz dosyalar üzerinde deneme yapıyorum.