Kapalı durumdaki farklı dosyalardan verileri alıp, tek bir dosyaya aktarma ve otomatik güncelleme

[uyelik.ben]

Merhaba,

Ekte 4 farklı dosya bulunuyor. Amacım 1,2,3. dosyadaki verileri "Dosya Linkli" isimli dosyada aynı başlıklar altında alt alta gelecek şekilde birleştirmek. Normalde bu linkleme aracılığı ile yapılıyor ancak 1,2,3. dosyalarda kolon açmam veya silmem durumunda başlık değişmemesine rağmen linki dosyadaki veriler kayıyor ve farklı hücrelere başvuru yapıyor.

Bu nedenle istediğim başlıkları yazabileceğim, dosya adlarını istediğim gibi değiştirebileceğim, istediğim satıra kadar erişecek bir linkleme benzeri makro çalışmasına ihtiyacım var.

Gün sonunda 20 farklı dosya uzantısı olan 20 farklı dosyadan 80 kolon için 1200 satırlık veri çekeceğim ve kolon ekleme çıkartma yaptığımda dosyalar kaymayacak. Bu kadar esnek alana sahip makro yazmak mümkün mü?

Yardımlarınız için teşekkürler.

 

[halit3]

Veri alınacak dosyaları bir klasöre koy sonra bu kodu bir dene
Not : Kodlar buraya eklediğiniz dosyalara göre yazıldı.

Sub deneme()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Worksheets(ActiveSheet.Name).Range("A2:B" & Rows.Count).ClearContents

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")

For Each dosya1 In fL.GetFolder(Kaynak).Files
dosya = dosya1
uzanti = fL.GetExtensionName(dosya)
sifre = ""
sayfa = "Sheet1"

Set Kayit = CreateObject("ADODB.recordset")
If uzanti = "xls" Then
baglan = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dosya & ";Extended Properties=""Excel 8.0;HDR=yes""" 'ofis 2003
Kayit.Open "Select * from [" & sayfa & "$] ;", baglan, 1, 1
ElseIf uzanti = "xlsb" Or uzanti = "xlsx" Or uzanti = "xlsm" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dosya & ";Extended Properties=""Excel 12.0;HDR=yes""" 'ofis 2007
Kayit.Open "Select * from [" & sayfa & "$] ;", baglan, 1, 1
Else
Exit Sub
End If
sat = Cells(Rows.Count, "A").End(3).Row + 1
Cells(sat, 1).CopyFromRecordset Kayit
Kayit.Close

Set Kayit = Nothing
Next

Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

 

[uyelik.ben]

Veri alınacak dosyaları bir klasöre koy sonra bu kodu bir dene
Not : Kodlar buraya eklediğiniz dosyalara göre yazıldı.

Sub deneme()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Worksheets(ActiveSheet.Name).Range("A2:B" & Rows.Count).ClearContents

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")

For Each dosya1 In fL.GetFolder(Kaynak).Files
dosya = dosya1
uzanti = fL.GetExtensionName(dosya)
sifre = ""
sayfa = "Sheet1"

Set Kayit = CreateObject("ADODB.recordset")
If uzanti = "xls" Then
baglan = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dosya & ";Extended Properties=""Excel 8.0;HDR=yes""" 'ofis 2003
Kayit.Open "Select * from [" & sayfa & "$] ;", baglan, 1, 1
ElseIf uzanti = "xlsb" Or uzanti = "xlsx" Or uzanti = "xlsm" Then
baglan = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dosya & ";Extended Properties=""Excel 12.0;HDR=yes""" 'ofis 2007
Kayit.Open "Select * from [" & sayfa & "$] ;", baglan, 1, 1
Else
Exit Sub
End If
sat = Cells(Rows.Count, "A").End(3).Row + 1
Cells(sat, 1).CopyFromRecordset Kayit
Kayit.Close

Set Kayit = Nothing
Next

Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

Merhaba,

Kod çalıştı ancak 2 kez kopyalama yaptı verileri 1 kez yapması yeterli. Diğer konuda dosyaların hepsini aynı yere koymam mümkün değil. Farklı konumlar tanımlamam ve konumların da değiştirilebilir olması gerekli.

Sayfa isimleri ve kolon sayısı her dosyada farklı. Bu yüzden onlarında esnek alan olması gerekli. kolon adım " İsim" diyelin, 1 dosyada "isim" li kolon A'da farklı dosyada B'de bu yüzden sadece "isim" yazılı kolonu bulup getirecek bana.

Dosyalarda değişiklik yaptığımda güncel veriyi getirmesi için makroyu çalıştırmam yeterli olacak mı?

Teşekkürler.

 

[metin_0606]

Merhaba,

Kod çalıştı ancak 2 kez kopyalama yaptı verileri 1 kez yapması yeterli. Diğer konuda dosyaların hepsini aynı yere koymam mümkün değil. Farklı konumlar tanımlamam ve konumların da değiştirilebilir olması gerekli.

Sayfa isimleri ve kolon sayısı her dosyada farklı. Bu yüzden onlarında esnek alan olması gerekli. kolon adım " İsim" diyelin, 1 dosyada "isim" li kolon A'da farklı dosyada B'de bu yüzden sadece "isim" yazılı kolonu bulup getirecek bana.

Dosyalarda değişiklik yaptığımda güncel veriyi getirmesi için makroyu çalıştırmam yeterli olacak mı?

Teşekkürler.

Sayın üyelik.ben keşke 3 nolu mesajda yazdıklarınızı 1 nolu mesajda belirtseydiniz yardımcı olacak arkadaşlar boşa zaman kaybı ve uğraş vermezlerdi

 

[uyelik.ben]

Sayın üyelik.ben keşke 3 nolu mesajda yazdıklarınızı 1 nolu mesajda belirtseydiniz yardımcı olacak arkadaşlar boşa zaman kaybı ve uğraş vermezlerdi

Bu nedenle istediğim başlıkları yazabileceğim, dosya adlarını istediğim gibi değiştirebileceğim, istediğim satıra kadar erişecek bir linkleme benzeri makro çalışmasına ihtiyacım var.

Gün sonunda 20 farklı dosya uzantısı olan 20 farklı dosyadan 80 kolon için 1200 satırlık veri çekeceğim ve kolon ekleme çıkartma yaptığımda dosyalar kaymayacak. Bu kadar esnek alana sahip makro yazmak mümkün mü? ( Burada açıkladığımı düşünüyorum) Daha detay bilgi gerekirse açıklama yaparım.

 

[Korhan Ayhan]

Eklediğiniz örnekler aynı yapıda olunca siz ne kadar açıklama yaparsanız yapın çok fazla birşey ifade etmiyor.

80 kolun demişsiniz. 20 farklı dosyada çekmek istediğiniz kolon isimleri ortak mı?
Mesela hepsinde başlıklar hep ilk satırda mı?
Verile hep A sütunundan mı başlıyor?

Esnek bir çalışma için daha detaylı bilgiye ve örnek dosyaya ihtiyaç oluyor.

 

[uyelik.ben]

Eklediğiniz örnekler aynı yapıda olunca siz ne kadar açıklama yaparsanız yapın çok fazla birşey ifade etmiyor.

80 kolun demişsiniz. 20 farklı dosyada çekmek istediğiniz kolon isimleri ortak mı?
Mesela hepsinde başlıklar hep ilk satırda mı?
Verile hep A sütunundan mı başlıyor?

Esnek bir çalışma için daha detaylı bilgiye ve örnek dosyaya ihtiyaç oluyor.

Örnek dosyaları paylaşamıyorum ancak gereksinimleri sıralayabilirim.

1) Dosyaların hepsi farklı yerlerde, isimlerinin hepsi farklı bu nedenle makronun içerisinde dosya yolu ve ismini tanımlayabileceğim esnek alana ihtiyacım var,
2) Her dosyada kolon ismi aynı ancak kolonların yerleri farklı bu nedenle tüm datanın içerisinden ilgili başlığın altında sıralanmış verileri bulup getirebilmeli ve ben hangi başlıkları istiyorsam makronun içerisinde tanımlama yapabilmeliyim,
3) Her dosyada kolon başlıkları aynı satırda"3" nolu satıda o sabit,
4) Her dosyanın toplam satır sayısı farklı ancak ilgili kolonun altında sadece o başlıkla ilgili veriler var ama kimi dosyada 80 satır, kimisinde 20 satır var bu yüzden son satıra kadar bulup veriyi getirmeli,
5)Veriler Hep A kolonu ile başlıyor ancak Kimi dosyada AZ de bitiyor, kimi dosyada K'da,

@Korhan Ayhan hocam farklı bir bilgi gerekiyorsa açıklamaya devam edebilirim ancak öncekim tecrübelerime istinaden hocalarımız yardım etmeye başladıktan sonra yeni cevaplar ve ihtiyaçlar doğuyor. bu yüzden tüm bilgileri en başta yazmak istemedim. Forumdaki örnek çalışmaları inceledim ancak bu kadar tanımlanabilir esnek alana sahip makro göremedim.

 

[Korhan Ayhan]

Excel sayfasında bir alanda bu esnek tanımlamalar yapılsa olur mu?

 

[uyelik.ben]

Excel sayfasında bir alanda bu esnek tanımlamalar yapılsa olur mu?

Verilerin tamamını birleştireceğim dosyada farklı bir sayfada bu tanımlamaların hepsini yapabilirim, şu dosya yoluna git, şu dosyayı bul, şu başlığın altındaki verileri getir alt at alta yaz gibi

 

[bmutlu966]

Önce dosyalarınızı inceleyip sonra Program dosyasındaki makroyu çalıştırınız. Farklı dosyalardaki A kolonunda bulunan başlıklara göre dosyalarınızı Program Ana Sayfasında toplar. Ancak dosyalarınız farklı klasörlerde olduğu için her dosya için makroyu tekrar çalıştırmanız gerekecektir. 50 kolon ile sınırladım. Umarım 50 kolonluk bilgi yeterlidir. DATA sayfası geçici olarak kullanılıyor bu sayfayı silmeyin.

 

[uyelik.ben]

Önce dosyalarınızı inceleyip sonra Program dosyasındaki makroyu çalıştırınız. Farklı dosyalardaki A kolonunda bulunan başlıklara göre dosyalarınızı Program Ana Sayfasında toplar. Ancak dosyalarınız farklı klasörlerde olduğu için her dosya için makroyu tekrar çalıştırmanız gerekecektir. 50 kolon ile sınırladım. Umarım 50 kolonluk bilgi yeterlidir. DATA sayfası geçici olarak kullanılıyor bu sayfayı silmeyin.

Elinize sağlık. Çalışıyor. Hangi kolonda hangi bilginin olduğunun bir önemi yok kolon adı aynıysa bulup getiriyor makronuz.

Tek kelimeyle. HELAL ! @Korhan Ayhan hocam sorun çözüldü gibi görünüyor. İlave sorularım olursa @bmutlu966 'ya sorarım.

 

[Korhan Ayhan]

Bende ADO ile çözüm hazırladım.

Alternatif olsun.

 

[halit3]

Alternatif dosya
not: Bu kodlar örnek dosyalarda çalışmaktadır. kodlar ado yöntemi ile yapılmıştır.
1 referanslarda bu olmalı microsoft activex data objects 2.x library
2-data ve veri sayfasındaki kolon isimleri aynı olmalı ve boşluksuz olmalı

 

[halit3]

Dosyayı güncelledim.

 

[Haluk]

Hadi bakalım........ şimdi sıra "yeğen"de....

.

 

[Seli]

Hocam excelleri indiremiyorum kodları paylaşabilir misiniz? Teşekkür ederim.