Kapalı olan dosyalarda son dolu satırı açık olan sayfaya aktarma

[saorest]

Arkadaşlar örnekte 2 adet kapalı dosyam mevcut bunların her birinde 5 adet sayfa var, kapalı olan dosyalardaki her sayfanın en son dolu satırının açık olan(Anasayfa) dosyama alt alta yazılmasını nasıl sağlarım, dosyalar aynı klasör içinde kullanılacaktır. Orjinal excel dosyalarımda yaklaşık 100 sayfa vardır.

 

[Levent Menteşoğlu]

Eklediğiniz örnekte hem xls hemde xlsx uzantılı dosya mevcut. Veri alınacak dosyalar hangi uzantıdadır. Ayrıca tüm sayfalardaki veriler örnek dosyalarınızdaki gibi B6 hücresindenmi başlamaktadır.

 

[saorest]

Levent bey ilginiz için teşekkür ederim, ekteki dosyanın uzantısını düzelttim .xls olarak, evet bütün sayfalar örnek te olduğu gibi b6 dan başlamaktadır .

 

[Levent Menteşoğlu]

Ekli dosyadaki klasörü bilgisayarınıza kopyaladıktan sonra "Anasayfa.xls" isimli dosyayı açın ve "Verileri Al" butonuna tıklayın. Kapalı dosyaların tüm sayfalarındaki son verileri ilgili sayfaya aktaracaktır.

 

[dEdE]

Merhaba,
Ben de amatörce birşeyler yapmıştım. Onu ekliyorum.
Sayın Menteşoğlu lütfedip incelerler ve görüşlerini belirtirlerse mutlu olurum.
Saygılar.

 

[Levent Menteşoğlu]

Merhaba,
Ben de amatörce birşeyler yapmıştım. Onu ekliyorum.
Sayın Menteşoğlu lütfedip incelerler ve görüşlerini belirtirlerse mutlu olurum.
Saygılar.

Merhaba Sn dEdE

Diğer alternatif mantık olan dosyaları açarak verileri alma yöntemini kullanarak hazırladığınız dosya, çok başarılı bir şekilde çalışıyor. Lütfen tebriklerimi kabul edin. Yalnız dosyanızdaki aşağıdaki satırda kırmızı renkle belirttiğim değişikliği yaparak dosyayı tekrar eklemenizi rica ederim.

son = Ana.[[COLOR=Red][B]a[/B][/COLOR]65536].End(3).Row + 1

 

[dEdE]

Merhaba,
Teşekkürler Sayın Menteşoğlu.
Belirttiğiniz değişikliği yaparak 5. mesajdaki dosyayı yeniledim.

 

[Levent Menteşoğlu]

Merhaba,
Teşekkürler Sayın Menteşoğlu.
Belirttiğiniz değişikliği yaparak 5. mesajdaki dosyayı yeniledim.

Rica ederim. Ayrıca dosyanıza eklediğiniz kodlarda amatörce değil bunuda belirtmek isterim. Son dönemde katettiğiniz gelişmeyi yakından takip ediyorum. Başarılarınızın devamını dilerim.

 

[saorest]

Levent bey cevabınız için teşekkür ederim, sayın dEdE sizede teşekkürler.
Arkadaşlar her iki dosyadaki kodlar verileri kasmadan gayet güzel işliyor , bana göndermiş olduğunuz cevaptaki makroyu ilerleyen zamanlarda başka dosyalarda da değişiklikler yaparak kullanacağım, öğrenmek adına aşağıdaki kodlar nerede ne işi yerine getiriyor açıklayabilir misiniz?

"Diğer sayfaların adı bile geçmeden her iki dosya ve her sayfadaki verileri nasıl buraya alabildik???"
"Bu kadar karışık kodu yazmanın ve öğrenmenin bir yöntemi var mı varsa nasıl yapabilrim?"

Sub verilerial()
[a5:k65536].ClearContents 'a5 ile k65536 arasında kalan alanı temizle
Application.ScreenUpdating = False 'urayı mesajlarını kapat
Set dnesne = CreateObject("Scripting.FileSystemObject")
Set anesne = CreateObject("ADODB.Connection")
Set cnesne = CreateObject("ADOX.Catalog")
Set klasor = dnesne.GetFolder(ThisWorkbook.Path)
For Each dosya In klasor.Files
If ThisWorkbook.Name <> dosya.Name Then
anesne.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & ThisWorkbook.Path & "\" & dosya.Name & "';Extended Properties=""Excel 8.0;HDR=no;IMEX=1"";"
cnesne.ActiveConnection = anesne
For Each sayfa In cnesne.Tables
sayfaadi = Replace(Replace(sayfa.Name, "'", ""), "$", "")
sorgu = "Select LAST(F1),LAST(F2),LAST(F3),LAST(F4),LAST(F5),LAST( F6),LAST(F7),LAST(F8),LAST(F9),LAST(F10) FROM [" & sayfaadi & "$b6:k5536]"
Set rs = anesne.Execute(sorgu)
If rs.EOF = False Then
sat = [a65536].End(3).Row + 1
Cells(sat, "a") = sayfaadi
Cells(sat, "b").CopyFromRecordset rs
End If
Next
anesne.Close
End If
Next
Set anesne = Nothing
Set cnesne = Nothing
Set rs = Nothing
[a5:k65536].Sort Key1:=[a5], Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

 

[Levent Menteşoğlu]

Yazarak anlatmak gerçekten zor bir iş. Ben çok fazla detaya giremeden aşağıda bir açıklama yazdım. Daha detaylı bilgi için istediğiniz soruyu sorabilirsiniz. Elimden geldiğince yanıtlamaya çalışırım.

Aslına bakarsanız, kullandığım mantık oldukça basittir. Yapılan, birkaç yöntemi iç içe kullanmaktan ibarettir. Öncelikle sorunuzun ana başlıklarını tekrar tanımlayalım.

1- Birden fazla kapalı dosyadan veri alınacak.
2- Her dosyanın tüm sayfalarından veri alınacak.
3- Her sayfanın sadece son satırındaki veri alınacak.
4- Alınan bu veriler alt alta listelenecek.

Yukarıdaki tanımlamadan sonra şimdi yapmamız gereken sıralamaya göre gerekli kod yapılarını tasarlamaktır. Tasarım, yine üstteki tanımlama sırasına göre yapılmalıdır. Buna göre;

1- Birden fazla kapalı dosyadan veri alınacak.

Dosya sayısı birden fazla olduğuna göre tüm dosyaları sırasıyla tanımlayacak bir döngü kullanılmak zorundadır. Bu döngü içerisinde dosya sistemi nesnesi kullanılarak ilgili dosyaların yoluna göre adları bulunmuş olur. Bu işlemi yapan aşağıdaki kod yapısıdır.

[SIZE=2][FONT=Verdana]Set dnesne = CreateObject("Scripting.FileSystemObject")[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set klasor = dnesne.GetFolder(ThisWorkbook.Path)[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]For Each dosya In klasor.Files[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]If ThisWorkbook.Name <> dosya.Name Then[/FONT][/SIZE]
[SIZE=2][FONT=Verdana].[/FONT][/SIZE]
[SIZE=2][FONT=Verdana].[/FONT][/SIZE]
[SIZE=2][FONT=Verdana].[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Next[/FONT][/SIZE]

Dosya sistemi nesnesi (file system object) ile ilgili olarak aşağıdaki link mutlaka incelenmelidir.

http://www.excel.web.tr/f60/file-system-object-t4488.html

2- Her dosyanın tüm sayfalarından veri alınacak.

Dosya adlarının bulunmasından sonra sıra verilerin alınacağı dosyalara bağlanmaya gelmiştir. Burada da ADO nesnesi kullanılmıştır. Aşağıda tamamen ADO ile bağlantıyı sağlayan ve verileri alan kodlar mevcuttur. Burada kapalı dosya içindeki tüm sayfa adlarını alan ADOX nesnesidir. Sayfa sayısı birden fazla olduğu için döngü kullanılmak zorundadır.

ADO hakkında detaylı örnekleri aşağıdaki linkte bulabilirsiniz.

http://www.excel.web.tr/f117/

[SIZE=2][FONT=Verdana]Set anesne = CreateObject("ADODB.Connection")[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set cnesne = CreateObject("ADOX.Catalog")[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]anesne.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & ThisWorkbook.Path & "\" & dosya.Name & "';Extended Properties=""Excel 8.0;HDR=no;IMEX=1"";"[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]cnesne.ActiveConnection = anesne[/FONT][/SIZE]
 
[SIZE=2][FONT=Verdana]For Each sayfa In cnesne.Tables[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]sayfaadi = Replace(Replace(sayfa.Name, "'", ""), "$", "")[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]sorgu = "Select LAST(F1),LAST(F2),LAST(F3),LAST(F4),LAST(F5),LAST( F6),LAST(F7),LAST(F8),LAST(F9),LAST(F10) FROM [" & sayfaadi & "$b6:k65536]"[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set rs = anesne.Execute(sorgu)[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]If rs.EOF = False Then[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]sat = [a65536].End(3).Row + 1[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Cells(sat, "a") = sayfaadi[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Cells(sat, "b").CopyFromRecordset rs[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]End If[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Next[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]anesne.Close[/FONT][/SIZE]

3- Her sayfanın sadece son satırındaki veri alınacak.

Alınacak verinin tanımlamasıda ADO nesnesi içindeki Sql sorgusu ile yapılmaktadır. Sorgu içindeki LAST fonksiyonu son veriyi getirmektedir. Yine sorgu içindeki F1, F2, F3, …… ifadeleri verilerin alınacağı sütunları tanımlamaktadır. Burada B6:K65536 aralığındaki birinci sütun olan B sütunu, F1 ile ifade edilmektedir. Ben ADO ile işlem yaparken recordset nesnesi yerine daha pratik olduğu için execute metodunu kullanmayı tercih ediyorum.

[SIZE=2][FONT=Verdana]sorgu = "Select LAST(F1),LAST(F2),LAST(F3),LAST(F4),LAST(F5),LAST( F6),LAST(F7),LAST(F8),LAST(F9),LAST(F10) FROM [" & sayfaadi & "$b6:k65536]"[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set rs = anesne.Execute(sorgu)[/FONT][/SIZE]

[SIZE=2][FONT=Verdana]If rs.EOF = False Then[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]sat = [a65536].End(3).Row + 1[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Cells(sat, "a") = sayfaadi[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Cells(sat, "b").CopyFromRecordset rs[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]End If[/FONT][/SIZE]

4- Alınan bu veriler alt alta listelenecek.

Alınan verileri alt alta listeleyen kodlarda aşağıdaki gibidir.

[SIZE=2][FONT=Verdana]sat = [a65536].End(3).Row + 1[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Cells(sat, "a") = sayfaadi[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Cells(sat, "b").CopyFromRecordset rs[/FONT][/SIZE]

Aşağıdada tüm satırların kullanım amaçlarını yazmaya çalıştım.

[FONT=Verdana][SIZE=2]Sub verilerial()[/SIZE][/FONT]
[SIZE=2][FONT=Verdana][a5:k65536].ClearContents 'a5 ile k65536 arasında kalan alanı temizle[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Application.ScreenUpdating = False 'ekran tazelemeyi kapat[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set dnesne = CreateObject("Scripting.FileSystemObject") 'dosya sistemi nesnesi oluştur[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set anesne = CreateObject("ADODB.Connection") 'ADO bağlantısı oluştur[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set cnesne = CreateObject("ADOX.Catalog") 'ADOX nesnesi oluştur[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set klasor = dnesne.GetFolder(ThisWorkbook.Path) 'aktif dosyanın bulunduğu klasörü tanımla [/FONT][/SIZE]
[SIZE=2][FONT=Verdana]For Each dosya In klasor.Files 'tanımlanan klasör içindeki dosyaları tek tek bulan döngü[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]If ThisWorkbook.Name <> dosya.Name Then 'aktif dosya dışındaki diğer dosyaları dikkate al koşulu[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]anesne.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & ThisWorkbook.Path & "\" & dosya.Name & "';Extended Properties=""Excel 8.0;HDR=no;IMEX=1"";" 'ADO bağlantısını açan komut[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]cnesne.ActiveConnection = anesne 'ADOX bağlantısını aç[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]For Each sayfa In cnesne.Tables 'sayfa isimlerini ADOX içinden bulan döngü[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]sayfaadi = Replace(Replace(sayfa.Name, "'", ""), "$", "") 'sayfa adını gereksiz sembollerden temizler[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]sorgu = "Select LAST(F1),LAST(F2),LAST(F3),LAST(F4),LAST(F5),LAST( F6),LAST(F7),LAST(F8),LAST(F9),LAST(F10) FROM [" & sayfaadi & "$b6:k65536]" 'son veriyi alan sql sorgusu[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set rs = anesne.Execute(sorgu) 'sorguyu çalıştırma[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]If rs.EOF = False Then 'sorgudan gelen veri boş değilse koşulu[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]sat = [a65536].End(3).Row + 1 'verilerin kaydedileceği son satırın satır numarasını bluma[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Cells(sat, "a") = sayfaadi 'A sütununa sayfa adını yazma[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Cells(sat, "b").CopyFromRecordset rs 'sorgu sonucu elde edilen verilerin kopyalanması[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]End If[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Next[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]anesne.Close 'ADO bağlantısını kapama[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]End If[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Next[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set anesne = Nothing[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set cnesne = Nothing[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]Set rs = Nothing[/FONT][/SIZE]
[SIZE=2][FONT=Verdana][a5:k65536].Sort Key1:=[a5], Order1:=xlAscending, Header:=xlGuess, _[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]DataOption1:=xlSortNormal[/FONT][/SIZE]
[SIZE=2][FONT=Verdana]End Sub[/FONT][/SIZE]

 

[saorest]

Levent bey zaman ayırıp detaylı anlatım yaptığınız için çok teşekkür ederim. Bu konu ile ilgili araştırma yapanların daha iyi yararlanacağına eminim. Bilginize, emeğinize, klavyenize sağlık.

 

[Erdem Akdemir]

Levent bey ne güzel anlatmışsınız.Keşke bu tarz paylaşımları daha sık yapsanız.

 

[Levent Menteşoğlu]

Levent bey ne güzel anlatmışsınız.Keşke bu tarz paylaşımları daha sık yapsanız.

Sn kuvari

Güzel düşünceleriniz nedeniyle teşekkür ederim. İş hayatım nedeniyle foruma artık eskisi kadar giremiyorum. Bu mesajınızıda ancak bugün görebildim. Geçmiş yıllarda bu tip açıklamalı cevaplar için yeterli zamanım oluyordu. Eğer o zamanı tekrar elde edebilirsem elbette paylaşımlara devam etmek benimde en büyük arzum. Ancak forumumuzda bu tip paylaşımları yapabilecek bilgi düzeyine sahip çok sayıda arkadaşımız mevcut. Zaten benim bu düşük aktiviteme rağmen yokluğumun hissedilmemesi bunun en büyük delilidir.