VBA ile yapılan ETOPLA İşleminin Hızını Arttırma Yolu

[Mdemir63]

Hocam kişilerin hangi ürünlerden ne kadarlık satış yaptığı

 

[Erdem Akdemir]

Korhan bey güzel bir konu oldu. Elinize sağlık.
Scripting.Dictionary nesnesinin hızı gözümde büyüdü.

 

[Korhan Ayhan]

@Mdemir63,

Örnek dosyanızda olması gereken sonucu ekleyip paylaşırsanız yardımcı olabilirim

 

[Mdemir63]

Selamlar

Korhan Hocam
dosyada çoketopla ile yaptığım örnek icmal sayfasında
Hocam zaten bunu çoketopla ile yapabiliyorsunuz ya da Pivot Table ile de yapabiliriz.
ancak etopla da yaptığınız Scripting.Dictionary nesnesi ile nasıl yapılabileceği benim için önemli

Saygılar

 

[Korhan Ayhan]

Deneyiniz.

Daha önce benzer kodlamanın paylaşıldığı bir başlık ektedir.

Formüllü sayfaları makroya çevirmek

Merhaba ornek1 adlı dosyada, formüllerin bulunduğu iki adet sayfa var. Bu iki saydadaki formüllerin makroya çevirilmesini rica ederim. Sebebi de şudur; formüller güzel fakat, satırlar 3000-4000 satır olduğunda, sadece F sütununun işlemi yapması bile yarım saatten fazla sürüyor. Ayrıca örnek2...

www.excel.web.tr

 

[Korhan Ayhan]

Paylaştığım dosyayı revize ettim.

3 farklı teknikle özet tablo (pivot) oluşuyor.

• Scripting.Dictionary ile özet tablo uygulaması
• ADO ile özet tablo uygulaması
• Makro ile özet tablo uygulaması

 

[Mdemir63]

Korhan Hocam çok teşekkür ederim.

Saygılar

 

[ccuneyt13]

Erdem Bey,

Özelden paylaştığınız dosyaya kodu uyarladım. Dosya Ektedir.

Sy. Korhan Hocam,
Ekli dosyamı uyarlamaya çalışıyorum ama sürekli hata alıyorum.
Tek fark başlıkların olduğu sütunlar farklı yerlerde.

For X = 2 To UBound(My_Data, 1)
        TCNO.Item(My_Data(X, 1)) = TCNO.Item(My_Data(X, 1)) + My_Data(X, 2)

Üstteki bu kodu;
Aşağıdaki gibi yapıyorum,

For X = 2 To UBound(My_Data, 1)
        TCNO.Item(My_Data(X, 1)) = TCNO.Item(My_Data(X, 4)) + My_Data(X, 3)

For X = 2 To UBound(My_Data, 1)
        Sum_List(X - 1, 1) = TCNO.Item(My_Data(X, 1))

Üstteki bu kodu;
Aşağıdaki gibi yapıyorum,

For X = 2 To UBound(My_Data, 1)
        Sum_List(X - 1, 1) = TCNO.Item(My_Data(X, 81))

S1.Range("B2").Resize(UBound(My_Data, 1), 1) = Sum_List

Bunu da aşağıdaki gibi yapıyorum,

S1.Range("CC2").Resize(UBound(My_Data, 1), 1) = Sum_List

Olmadı bir türlü,
Tüm kodu okuyup anlayamadığım için başka değiştirmem gereken yerler muhtemelen oraları çözemedim
Saygılar.

 

[Erdem Akdemir]

Sayfa1'de A sütunundaki veriler Sayfa2'de karşılığı yok. Sayfa1'deki CB sütununu kodda kullanmalısınız.
CB sütununu kullanacaksanız dizideki elemanların dördüncüsü almalısınız. Kodu aşağıdaki gibi kullanabilirsiniz.

Option Explicit

Sub FAST_SUMIF()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim TCNO As Object, X As Long
    Dim My_Data As Variant, Sum_List As Variant
    Dim Count_Data As Long, Process_Time As Double
    
    Process_Time = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set TCNO = VBA.CreateObject("Scripting.Dictionary")
    
    S1.Range("B2:B" & S1.Rows.Count).ClearContents
    
    My_Data = S2.Range("A1").CurrentRegion.Value
    
  '  ReDim Sum_List(1 To UBound(My_Data, 1), 1 To 1)
    
    For X = 2 To UBound(My_Data, 1)
        TCNO.Item(My_Data(X, 4)) = TCNO.Item(My_Data(X, 4)) + My_Data(X, 3)
    Next
        
    My_Data = S1.Range("CB1:CB20")
    
    ReDim Sum_List(1 To UBound(My_Data, 1), 1 To 1)
    
    For X = 2 To UBound(My_Data, 1)
        Sum_List(X - 1, 1) = TCNO.Item(My_Data(X, 1))
    Next
    
    S1.Range("CD2").Resize(UBound(My_Data, 1), 1) = Sum_List
    S1.Columns("B").AutoFit
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set TCNO = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Process_Time, "0.00") & " Saniye", vbInformation
End Sub

 

[ccuneyt13]

Sayfa1'de A sütunundaki veriler Sayfa2'de karşılığı yok. Sayfa1'deki CB sütununu kodda kullanmalısınız.
CB sütununu kullanacaksanız dizideki elemanların dördüncüsü almalısınız. Kodu aşağıdaki gibi kullanabilirsiniz.

Erdem Bey Merhaba,
Teşekkür ederim dönüşünüz için.

Haklısınız Sayfa1 A sütunundaki verilerle işim yok. CB kullanmalıyım.

 My_Data = S1.Range("CB1:CB20")

Burada örnekte 20 satır veri var lakin gerçek dosyamda veri sayısı 80-100 bin arası değişiyor.
Dolayısıyla bu tanımlamayı CB1 ile CB son dolu hücreye kadar yapacak şekilde nasıl güncellemem lazım?
Saygılar.

 

[Korhan Ayhan]

Deneyiniz.

My_Data = S1.Range("CB1:CB" & S1.Cells(S1.Rows.Count, "CB").End(3).Row)

 

[ccuneyt13]

Deneyiniz.

My_Data = S1.Range("CB1:CB" & S1.Cells(S1.Rows.Count, "CB").End(3).Row)

Sayın Hocam oldu, çok teşekkür ederim.