subtotal çok yavaş ----acil----

[cagriyildirim]

(foksiyonlar bölümüne açacaktım ,sonra buraya daha uygun olduğunu düşündüm.)

subtotal fonksiyonunu kullandığım bir makrom var. bu makroyla yaklaşık 60.000 satırlık belgeyi subtotal yapıyorum ama çok yavaş yapıyor. hızlandırabileceğimiz bir kod ya da başka önerisi olan var mı ?

 

[Zeki Gürsoy]

Merhaba,

Süzgeçlere bağlı olarak çalışması şart değilse, SQL ile hesapanabilr.
Örnek dosya ekleyiniz.

 

[cagriyildirim]

sayfa1 elimdeki belgenin örneği( 60.000 satırı buluyor gerçeği)
sayfa2 de subtotal hali
sayfa 3 de benim en son elde etmek istediğim formatta.
teşekkürler

 

[Zeki Gürsoy]

Ekli dosyayı inceleyin. 2007 biçimi için connction string düzenlenmesi gerekecek bilginize..

Sub totals()
Dim cn As Object, rs As Object

Set cn = CreateObject("ADODB.Connection")

cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};Dbq=" & _
    ThisWorkbook.FullName
    
Set rs = cn.Execute( _
"select distinct isim, sum(başvuru), sum(başarı) " & _
"from [Sayfa1$] " & _
"group by isim")

Sheets("zeki").[a2].CopyFromRecordset rs

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing

Sheets("zeki").Activate
End Sub

 

[cagriyildirim]

connection string düzenlenmesi nasıl yapılıyor bilmiyorum. direk denedim ve çalıştı. ne kadar teşekkür etsem az, harikasın.

 

[Zeki Gürsoy]

Pekala, 2007 için düzenlenmiş proseduru düzenleyip birazdan ekleyeceğim.

 

[Zeki Gürsoy]

Proseduru aşağıdaki ile değiştirin ancak, rapor sayfası adı ne olacaksa
"zeki" geçen yerleri onunla değiştirmeyi unutmayın.

Sub totals()
Dim cn As Object, rs As Object

Set cn = CreateObject("ADODB.Connection")

cn.Open _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & _
"Extended Properties=""Excel 12.0;HDR=YES"";"
    
Set rs = cn.Execute( _
"select distinct isim, sum(başvuru), sum(başarı) " & _
"from [Sayfa1$] " & _
"group by isim")

With [COLOR=Blue][B]Sheets("zeki")[/B][/COLOR]
    .[a2:c65536].ClearContents
    .[a2].CopyFromRecordset rs
End With

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing

End Sub

 

[cagriyildirim]

yardımın için çok teşekkürler ama son yazdığın program "yüklenebilir ISAM bulunamadı" hatası veriyor.