Pivot Tabloda Çarpma İşlemi

[mukoli]

Merhaba ustalar ekteki dosyada gerekli açıklamayı yaptım. Sizden yardımınızı bekliyorum teşekkür ederim

 

[Cengiz Demir]

Merhabalar. özet tabloda herhangi bir hücre seçili iken;
PivotTable analizi / Alanlar Öğeler ve Kümeler / Hesaplanmış alan seçerek Tutar alanı ekleyebilirsiniz.
Alanları fare ile tıklayarak formül kutucuğuna ekleyebiliyorsunuz.

Daha sonra alan listesinden seçerek bu alanı tablonuzda aktif hale getirebilirsiniz.

 

[mukoli]

Hocam onu yaptım fakat istediğim gibi olmadı ya toplamı yanlış gösteriyor genel toplamı

 

[Cengiz Demir]

Evet genel toplamı da hesaplayarak yaptığı için yanlış gösteriyor. Başka bir yöntemi var mıdır ben de bilmiyorum.

 

[mukoli]

Teşekkür ederim bilen birisi inşallah yardım eder

 

[Korhan Ayhan]

Ekteki gibi olabilir..

 

[mukoli]

Hemen bakıyorum hocam sizin makronuz vardı . O şekildede yapabilirmiyiz makro ile gruplayarak

 

[mukoli]

Korhan hocam bu kodunuzu benim sayfaya göre uyarlayabilme şansınız varmıdır. Ben uğraştım ama birtürlü beceremedim

Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Urun_Grubu As Variant
    Dim Veri As Variant, Son As Long, Satir As Long, Kayit_Sayisi As Long, Say As Long
    Dim Alan_1 As Range, Alan_2 As Range, X As Long, Y As Long, Z As Byte, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("KIRPILMIS")
    Set S2 = Sheets("GRUP")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    S2.Cells.Delete
    Satir = 3

    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    
    S1.Cells(1, 27) = "Sıra No"
    
    With S1.Range("AA2")
        .Value = 1
        .AutoFill Destination:=S1.Range("AA2:AA" & Son), Type:=xlFillSeries
    End With
    
    S1.Range("A2:AA" & Son).Sort S1.Range("K2"), xlAscending, S1.Range("B2"), , xlAscending
    
    Veri = S1.Range("A1:K" & Son).Value
    
    S1.Range("A2:AA" & Son).Sort S1.Range("AA2"), xlAscending
    S1.Range("AA:AA").Clear
    
    With Dizi
        For X = LBound(Veri) + 1 To UBound(Veri)
            If Veri(X, 11) <> "" Then .Item(Veri(X, 11)) = 1
        Next
    End With
    
    Urun_Grubu = Dizi.Keys
    
    Kayit_Sayisi = Son + Dizi.Count * 2 * 2 - 2
    
    ReDim Liste(1 To Kayit_Sayisi, 1 To 11)
    
    Say = 1
    
    For X = LBound(Urun_Grubu) To UBound(Urun_Grubu)
        If Say = 1 Then Liste(Say, 11) = Now
        Liste(Say + 1, 1) = Urun_Grubu(X)
        If Alan_1 Is Nothing Then
            Set Alan_1 = S2.Cells(Say + 1, 1).Resize(, 11)
            Set Alan_2 = S2.Cells(Say + 2, 1).Resize(, 11)
        Else
            Set Alan_1 = Union(Alan_1, S2.Cells(Say + 1, 1).Resize(, 11))
            Set Alan_2 = Union(Alan_2, S2.Cells(Say + 2, 1).Resize(, 11))
        End If
        
        Say = Say + 2
        
        For Y = LBound(Veri) To UBound(Veri)
            If Y = 1 Then
                For Z = 1 To 11
                    Liste(Say, Z) = Veri(Y, Z)
                Next
            Else
                If Veri(Y, 11) = Urun_Grubu(X) Then
                    Say = Say + 1
                    For Z = 1 To 11
                        If Z = 1 Then
                            Liste(Say, Z) = CStr(Veri(Y, Z))
                        Else
                            Liste(Say, Z) = Veri(Y, Z)
                        End If
                    Next
                End If
            End If
        Next
        Say = Say + 2
    Next
    
    S2.Range("A:A").NumberFormat = "@"
    S2.Range("A1").Resize(Say - 2, 11) = Liste
    
    If Not Alan_1 Is Nothing And Not Alan_2 Is Nothing Then
        With Alan_1
            .MergeCells = True
            .Font.Bold = True
            .Interior.Color = 14277081
            .HorizontalAlignment = xlCenter
        End With
    
        With Alan_2
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
        End With
    End If
    
    S2.Range("A:K").ColumnWidth = 255
    S2.Rows.AutoFit
    S2.Columns.AutoFit
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[Korhan Ayhan]

Merhaba,

Konu başlığınız özet tabloyla ilgiliydi ve yanıtladık diye düşünüyorum. Şimdi makroyla ilgili destek talebiniz var.

Bu sebeple makrolar bölümüne konu açarak destek talebinde bulunabilirsiniz.

 

[mukoli]

Tamamdır hocam teşekkür ederim