Kapalı excel dosyalarında toplam dolu hücre sayısı

[ASLAN7410]

Merhaba hayırlı geceler.

Daha önceden forumdan yararlanarak masa üstündeki ÇALIŞMA klasörü içerisindeki excel dosyalarının isimlerini alan makro yazılmıştı.

Şimdi ise bu ÇALIŞMA klasörü içindeki kapalı dosyaların A sütunundaki dolu hücrelerin toplamını almak istiyorum.

Veri sayfam çok olduğu için hepsini açıp kapamak çok zaman alıyor.
Bu konuda araştırdım ancak kendime uygun bir bilgi bulamadım.

Yardımcı olur musunuz?

 

[Murat OSMA]

Merhabalar

Excel Arşivi'nde bu tarz kapalı dosya işlemleri ile, özellikle de ADO ile alâkalı birçok dosya bulabilirsiniz.

Bu kodlar işinizi görecektir..

[FONT="Trebuchet MS"][SIZE="2"]Sub Emre()
    Set Con = CreateObject("AdoDB.Connection")
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Yol = ThisWorkbook.Path & "\ÇALIŞMA"
    Set Klasor = Fso.GetFolder(Yol): sat = 2
    For Each Dosyalar In Klasor.Files
        Con.Open "Provider=Microsoft.ace.OleDb.12.0;Data Source=" & _
        Dosyalar & ";Extended Properties=""Excel 12.0;HDR=no"""
        Set Rs = Con.Execute("Select count(F1) FROM [Sayfa1$]")
        Cells(sat, 2).Value = Replace(Dosyalar.Name, ".xlsx", "")
        Cells(sat, 3).Value = Rs(0).Value
        sat = sat + 1
        Con.Close
    Next Dosyalar
End Sub[/SIZE][/FONT]

 

[ASLAN7410]

Sayın Murat Bey ilginiz için çok teşekkür ediyorum, hayırlı geceler.

Kod gayet güzel çalışıyor, ellerinize sağlık.

Her sayfanın başında bir başlık olduğu için, dolu hücre sayısı hepsinde 1 fazla veriyor. Yani başlıkları saymasını istemiyorum.

1 tane eksiltmeyi kod içine yazabilir misiniz?

 

[ASLAN7410]

Sayın Murat Bey formüllerle hallettim, ellerinize sağlık Allah razı olsun, hayırlı geceler diliyorum.

 

[ASLAN7410]

Sayın Murat Bey kodu kendi orijinal sayfamda uyguladığımda Set Rs = Con.Execute("Select count(F1) FROM [Sayfa1$]")
kod bu satırı sarıya boyuyor, Sayfa1 isimleri sabit olmadığı için hata veriyor zannedersem.

Veri çok olduğu için sayfa isimlerini değiştirmek daha da zahmetli olacak.

Yardımcı olur musunuz?

 

[Murat OSMA]

Başlıkları saymaması için Rs(0).Value - 1 yazabilirsiniz.

Her dosyada tek sayfa mı var?
Sadece sayfa isimleri mi farklı?​

 

[ASLAN7410]

Sayın Murat Bey her dosyada tek sayfa var.

 

[Murat OSMA]

Kodları bu şekilde revize edebilirsiniz..
İlave edilen kodları kırmızıya boyadım..

[FONT="Trebuchet MS"][SIZE="2"]Sub Emre()
    Range("B2:C100").ClearContents
    Set con = CreateObject("AdoDB.Connection")
[COLOR="Red"]    Set cat = CreateObject("Adox.Catalog")
    Set syf = CreateObject("Adox.Table")[/COLOR]
    Set fso = CreateObject("Scripting.FileSystemObject")
    Yol = ThisWorkbook.Path & "\ÇALIŞMA"
    Set Klasor = fso.GetFolder(Yol): sat = 2
    For Each Dosyalar In Klasor.Files
        con.Open "Provider=Microsoft.ace.OleDb.12.0;Data Source=" & _
        Dosyalar & ";Extended Properties=""Excel 12.0;HDR=no"""
        [COLOR="red"]cat.ActiveConnection = con[/COLOR]
        [COLOR="red"]For Each syf In cat.Tables[/COLOR]
            Set Rs = con.Execute("Select count(F1) FROM [[COLOR="red"]" & syf.Name & "[/COLOR]]")
            Cells(sat, 2).Value = Replace(Dosyalar.Name, ".xlsx", "")
            Cells(sat, 3).Value = Rs(0).Value [COLOR="red"]- 1[/COLOR]
            sat = sat + 1
            con.Close
        [COLOR="red"]Next syf[/COLOR]
    Next Dosyalar
End Sub[/SIZE][/FONT]

 

[ASLAN7410]

Sayın Murat Bey ellerinize sağlık süper oldu, çok teşekkür ediyorum, Allah razı olsun.

Hayırlı çalışmalar hayırlı geceler diliyorum.

 

[Murat OSMA]

Rica ederim, hayırlı geceler.​