Kapalı Excel Dosyalarındaki Hücreleri Toplatma

[Sa.NaL]

Merhaba Benim excel uzmanı arkadaşlardan ricam benim d sürücümde ocak 2009 klaösürü içinde 55 adet excel çalışma kitabı var bunların her birinin 1 .sayfasının A20 hücrelerinde fiyat yazmaktadır.Bana öyle bir kod yazınızki ocak 2009 içindeki excel dosyalarının A20 hücrelerinin toplamını userform1.textbox1.value de yazsın.AMa excel dosya sayısı her ay değişebilir isim isim çalışma kitaplarını yazarak toplatıyorum ama çok uzun bunun döngüye sokulup değişen excel dosya sayılarına göre toplatabilme imkanı varmı acaba?

 

[Sa.NaL]

Sayın Levent Menteşoğlunun eski konulardan sütunlar için kapalı excel dosyasından vermiş olduğu örneği buldum bu kodlar kullanılarak yapılamaz mı acaba istediğim şey yardımcı olabilecek var mı?
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFold er("C:\zeliha").Files
sat = WorksheetFunction.CountA(Columns(1))
For sut = 3 To 33
Cells(sat + 1, sut-2) = ExecuteExcel4Macro("'C:\zeliha\[" & dosya.Name & "]sayfa1'!R" & sut & "C4")
Next: Next
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder("D:\ocak 2009").Files
deg=deg+ ExecuteExcel4Macro("'D:\ocak 2009\[" & dosya.Name & "]sayfa1'!R20C1")
Next
textbox1=deg

Not: Tüm dosyaların birinci sayfa adlarının "sayfa1" olduğu kabul edilmiştir.

 

[Sa.NaL]

R20C1 hangi hücre oluyor sayın levent menteşoğlu?

 

[Sa.NaL]

levent hocam bu kodun neresinde yanlışlık anlayamadım
az bakarmısınız acaba
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dosya_Yolu = "D:\Ocak 2009\"
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each dosya In Klasör
If InStr(dosya.Name, ".xls") > 0 Then
Workbooks.Open Filename:=dosya
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder("D:\Ocak 2009").Files
deg = deg + ExecuteExcel4Macro("'D:\Ocak 2009\[" & dosya.Name & "]sayfa1'!R20C1")
Next
TextBox1 = deg

End Sub


For Each dosya In hata veriyor

 

[Levent Menteşoğlu]

Benim yazdığım kodu neden denemiyorsunuz.

 

[Sa.NaL]

Denedim hocam şuan toplatıyor çok tşk ederim ama bir ufak sorunum var atıyorum 50 excel dosyası içinden toplatıyorum örneğin hepsi açılıyor ana dosyam hariç onları nasıl kaparım

 

[Sa.NaL]

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Dosya_Yolu = "D:\Ocak 2009\"
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each dosya In Klasör
Workbooks.Open Filename:=dosya
deg = deg + ExecuteExcel4Macro("'D:\Ocak 2009\[" & dosya.Name & "]sayfa1'!R20C1")
Next
TextBox1 = deg
Workbooks.Close Filename:=dosya

End Sub

böyle yaptım closede hata verdi

 

[Levent Menteşoğlu]

Verdiğim kod direk kapalı dosyadan veri alır. Dolayısıyla dosyaların açılmasına gerek yok. Aşağıdaki gibi kullanabilirsiniz.

Private Sub CommandButton1_Click()
Dosya_Yolu = "D:\Ocak 2009\"
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFold er(Dosya_Yolu).Files
For Each dosya In Klasör
deg = deg + ExecuteExcel4Macro("'D:\Ocak 2009\[" & dosya.Name & "]sayfa1'!R20C1")
Next
TextBox1 = deg
End Sub

Not: R20C1: A20 hücresinin R1C1 başvuru stiliyle yazılmış halidir. R20: 20.satır(Row) ,C1: 1.sütun(Column)

 

[Sa.NaL]

Teşekkürler Levent hocam

 

[tahsinanarat]

Sn. Levent hocam, aynı sayfların saadece a20 hücrelerinin yanı sıra b20 c20 d20 vs. şeklinde devam etseydi, kod nasıl olmalıydı. cevabınız için şimdiden teşekkürler hocam.

 

[Sa.NaL]

Sn. Levent hocam, aynı sayfların saadece a20 hücrelerinin yanı sıra b20 c20 d20 vs. şeklinde devam etseydi, kod nasıl olmalıydı. cevabınız için şimdiden teşekkürler hocam.

Kardeş levent hocamdan istedin ama bende fikir vereyim kendi çapımda her birinin A20 sini B20 sini C20 sini ayrı ayrı textlere eşitle daha sonra tüm textleri tek bir texte yada nereye eşitlemek istersen oraya eşitleyebilirsin kardeş...mesela
Dosya_Yolu = "D:\Ocak 2009\"
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each dosya In Klasör
deg1= deg1 + ExecuteExcel4Macro("'D:\Ocak 2009\[" & dosya.Name & "]sayfa1'!R20C1")
deg2 = deg2 + ExecuteExcel4Macro("'D:\Ocak 2009\[" & dosya.Name & "]sayfa1'!R20C2")
Next
TextBox1 = deg1
TextBox2 = deg2
TextBox3=deg1+deg2

 

[Levent Menteşoğlu]

Tahsin bey örneğin; A20: D20 aralığını toplatacaksanız kodu aşağıdaki gibi düzenleyebilirsiniz.

Dosya_Yolu = "D:\Ocak 2009\"
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each dosya In Klasör
deg = deg + ExecuteExcel4Macro[COLOR=red][B]("SUM('D:\Ocak 2009\[" & dosya.Name & "]sayfa1'!R20C1:R20C4)")[/B][/COLOR]
Next
textbox1 = deg

Not: Sn Sa.NaL'ın önerdiği gibide olabilir.

 

[Sa.NaL]

Levent hocamın ki profesyonel işi ellerinize sağlık

 

[tahsinanarat]

Sn. Levent hocam, benim istediğim A2020 aralığını toplamak değilde, 9.mesajınızda verdiğiniz kodlarda, kapalı dosyalardaki Sayfa1 lerin a20 hücresini topluyor, ben buna artı olarak Sayfa1'lerin B20, C20, D20, E20.... gibi toplayıp, textbok1'e değilde toplayacağımız, yani açık olan kitabın A21, B21, C21,D21,E21 .. ine toplam almasını kastetmiştim. Saygılarımla.

 

[tahsinanarat]

Sn. Sa.Nal'ın verdiği mantıkla Sn. Levent hocamın kodlarını aşağıdaki gibi yaptım oldu, teşükkür ederim.

Private Sub CommandButton1_Click()
Dosya_Yolu = "C:\deneme\"
Set Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Dosya_Yolu).Files
For Each dosya In Klasör
deg1 = deg1 + ExecuteExcel4Macro("'C:\deneme\[" & dosya.Name & "]sayfa1'!R20C1")
deg2 = deg2 + ExecuteExcel4Macro("'C:\deneme\[" & dosya.Name & "]sayfa1'!R20C2")
deg3 = deg3 + ExecuteExcel4Macro("'C:\deneme\[" & dosya.Name & "]sayfa1'!R20C3")
deg4 = deg4 + ExecuteExcel4Macro("'C:\deneme\[" & dosya.Name & "]sayfa1'!R20C4")
Next
Range("a1") = deg1
Range("b1") = deg2
Range("c1") = deg3
Range("d1") = deg4
End Sub

 

[Sa.NaL]

Sevgi Emek İster,Excel'i Seviyoruz.....