Özet Tablo Ve Topla.Çarpım Makrosu

[o2l3m]

Merhaba öncelikle kolay gelsin

3 aylık bir datam var. Formül ve özet tablo ile işimi görüyorum. Fakat dosya çok kasıyor.
Ekli dosyada bu durumu makro ile çözebilirmiyiz?

Yapılmak istenen;
Sarı işaretli 3 Başlığı Data sayfasından özet verilerini getirecek ve A dan Z ye Sıralayacak
Toplam Sütunun da Topla.Çarpım ile yazdığım formülü makro ile hesap edecek.

 

[YUSUF44]

Özet taablonun zaten yapması gereken işi siz Topla çarpım ile elde etmeye çalışmışsınız gördüğüm kadarıyla.

Özet tablo raporunda Yield alanını Değerler kısmına ekleyin ve değer alanı kısmında Toplam seçeneğini seçin. böylece Topla.çarpımla elde ettiğiniz sonuçlar özet tablo içinde görünecektir.

Ayrıca aşağıdaki kodları Özet tablo sayfasının kod bölümüne (sayfa adına sağ tıklayıp Kod Görüntüle deyince açılan sayfaya) yapıştırırsanız, Özet tablo sayfasını her açtığınızda özet tabloyu otomatik yeniler:

Private Sub Worksheet_Activate()
    son = Sheets("Data").Cells(Rows.Count, "B").End(3).Row
    ActiveSheet.PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ActiveWorkbook.Sheets("Data").Range("B3:R" & son))

    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Malzeme").AutoSort _
        xlAscending, "Malzeme"

End Sub

 

[o2l3m]

Teşekkürler Yusuf Bey

Bu bir çözüm elbette. Fakat elimde 120.000 satırlık bir veri var. Yield kısmından sonra ilave hesap sütunları ve koşullu biçimler de mevcut. Makinem i7 işlemci olmasına rağmen Özet tablo da refresh ettiğimizde epey zorlanıyor.

En azından Özet tablo ve formüllü sütunu hafifletebilirsem (Makro ile) daha rahat çalışma imkanı kazanacağım.

 

[Merhum İdris SERDAR]

.

Buradaki açıklamaları inceleyin.

http://www.excel.web.tr/f60/optimal-bir-excel-dosyasy-icin-altyn-kurallar-t74806.html

.

 

[o2l3m]

İdris Bey Bilgilendirme için teşekkürler.
Birçoğunu biliyor ve günlük iş hayattımda uyguluyorum. 18 yıldır da aktif olarak Excel kulanmaktayım.

Sanıyorum özet tablo ile yaptığımı makro ile yapmak için destek alamıyacağım.

 

[Ömer]

Merhaba,

Deneme adında bir sayfa açın ve sonuçları gözlemleyin.
İstediğiniz bu mu?

Sub Ozet_Al()

    Dim d As Object, i As Long, s, deg

    Set d = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Sheets("Data").Select

    For i = 4 To Cells(Rows.Count, "D").End(xlUp).Row
        deg = Cells(i, "D") & "|" & Cells(i, "R") & "|" & Cells(i, "N")
        If Not d.exists(deg) Then
            s = Cells(i, "H")
            d.Add deg, s
        Else
            s = d.Item(deg)
            s = s + Cells(i, "H")
            d.Item(deg) = s
        End If
    Next i

    Sheets("[COLOR="Red"]Deneme[/COLOR]").Select
    Range("B2:E" & Rows.Count).ClearContents
    Range("D2").Resize(d.Count, 2) = _
        Application.Transpose(Array(d.keys, d.items))
        
    Application.DisplayAlerts = False
    Range("D2:D" & d.Count + 1).TextToColumns Destination:=Range("B2"), _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            Other:=True, OtherChar:="|", TrailingMinusNumbers:=True
        
    Columns("B:E").EntireColumn.AutoFit

    Range("B2:E" & d.Count + 1).Sort _
        Key1:=Range("B2"), Order1:=xlAscending, _
        Key2:=Range("C2"), Order2:=xlAscending, _
        Key3:=Range("D2"), Order3:=xlAscending

    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

End Sub

Not: Başlık satırını B1:E1 arasına siz yazarsınız.

.

 

[o2l3m]

Çok teşekkürler Ömer Bey
İstediğim tam olarak buydu. Emeğinize sağlık.