Soru Pivot Table Alternatifi

[tuvons]

Arkadaşlar merhaba,

Pivot table ile yapabileceğimiz bir işlemi makro ile hızlıca yapmak istiyorum ama kodları yazamadım.

4 farklı sayfam var. Sayfalarda A sütununda şehir plakaları, B sütununda mağaza kodları ve C sütununda satış tutarları var. Bunları farklı bir dosyada Mağaza koduyla sayfaları isimlendirip şehirlerin satış tutarlarını ayırıyorum ama bunları çoketopla fonksiyonu ile yapıyorum ve zaman alıyor. Bunun için kullanabileceğim bir makro var mıdır acaba?

Dosya ekleyemiyorum kusura bakmayın. Yardımcı olabilirseniz sevinirim.

 

[Korhan Ayhan]

Merhaba,

Bu tarz sorularınız için örnek dosya paylaşmanız çözüm sürecini hızlandıracaktır.

 

[tuvons]

Merhaba,

Ekteki dosyayı hazırladım örnek olarak. Sayfa1, Sayfa2 ve Sayfa3'te yer alan mağaza koduna çift tıklayınca ayrı bir dosyaya mağaza koduyla sayfayı açıyorum. Açılan sayfada il koduna göre satış tutarlarını getirmek istiyorum. Örnek dosyada mağaza koduna göre çoketopla fonksiyonu ile toplamları getiriyorum ama veri aldığım satır sayısı çok olduğu zaman işlem süresi uzuyor.

Makro ile verileri nasıl alabilirim? Yardımcı olabilir misiniz?

https://s2.dosya.tc/server13/2znt89/calisma.xlsx.html

 

[Korhan Ayhan]

İlgili sayfalarda "B" sütunundaki mağaza kodu alanına çift tıklayıp deneyiniz.

Harici Link (Silinebilir) ; https://s2.dosya.tc/server13/a5os7d/Sayfalardan_Ozet_Tablo_Olusturma.xlsm.html

 

[tuvons]

Sayın @Korhan Ayhan çok teşekkür ederim, çok güzel bir çalışma olmuş. Ellerinize sağlık.

Bu dosyayı kendi çalışmama uygulamak istiyorum. Bu dosyada Sayfa1, Sayfa2 ve Sayfa3'teki veriler aynı sütundaydı. Mesela sadece Sayfa1'deki Mazağa kodları ve satış tutarları F ve G sütununda olsaydı diğer sayfalarda yine B ve C sütununda, o zaman nasıl bir yol izlemem gerekirdi?

 

[Korhan Ayhan]

O zaman kodlamaya sorgu satırı eklemek gerekirdi.

 

[tuvons]

Beni yönlendirebilir misiniz? Bu konuda biraz uğraşmak istiyorum. Nasıl sorgu ekleyebilirim? Destek alabileceğim bi yazı var mı?

 

[Korhan Ayhan]

Bu tarz geliştirmeler için kod yazma tekniklerini bilmelisiniz. Direkt bu konuyla ilgili bir makale benim bildiğim yok.

Öğrenmek istiyorsanız Altın Üyelik satın alıp forumun Dershane-Örnek Uygulamalar vb. bölümlerinden faydalanabilirsiniz.

Ya da nette bulunan videolu ders-konu anlatımlarını izleyip uygulamalar yapabilirsiniz.

Aşağıdaki kodu bahsettiğiniz yapıda kullanabilirsiniz.

Option Explicit

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim S1 As Worksheet, Dizi As Object, Magaza_Kodu As Long, X As Long
    Dim Veri As Variant, Son As Long, Say As Long, Zaman As Double
        
    If Sh.Name = "Sayfa1" Then
        If Intersect(Target, Range("F2:F" & Rows.Count)) Is Nothing Then Exit Sub
    Else
        If Intersect(Target, Range("B2:B" & Rows.Count)) Is Nothing Then Exit Sub
    End If
    
    Zaman = Timer
    
    Magaza_Kodu = Target
    
    On Error Resume Next
    Set S1 = Nothing
    Set S1 = Sheets(CStr(Magaza_Kodu))
    On Error GoTo 0
    
    If Not S1 Is Nothing Then
        S1.Range("A2:B" & S1.Rows.Count).ClearContents
        S1.Range("A2:A" & S1.Rows.Count).NumberFormat = "@"
        S1.Range("B2:B" & S1.Rows.Count).Style = "Comma"
    Else
        Set S1 = Sheets.Add(, Sheets(Sheets.Count))
        S1.Name = Magaza_Kodu
        S1.Range("A1:B1").Font.Bold = True
        S1.Range("A1:B1") = Array("İL KODU", "SATIŞ TUTARI")
        S1.Range("A2:A" & S1.Rows.Count).NumberFormat = "@"
        S1.Range("B2:B" & S1.Rows.Count).Style = "Comma"
    End If
    
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    
    ReDim Liste(1 To Rows.Count, 1 To 2)
    
    For Each Sh In ThisWorkbook.Sheets
        Select Case Sh.Name
            Case "Sayfa1", "Sayfa2", "Sayfa3"
        
            Son = Sh.Cells(Sh.Rows.Count, 1).End(3).Row
            If Son <= 2 Then Son = 3
        
            If Sh.Name = "Sayfa1" Then
                Veri = Sh.Range("A2:G" & Son).Value
                For X = LBound(Veri, 1) To UBound(Veri, 1)
                    If Veri(X, 6) = Magaza_Kodu Then
                        If Not Dizi.Exists(Veri(X, 1)) Then
                            Say = Say + 1
                            Dizi.Add Veri(X, 1), Say
                            Liste(Say, 1) = Veri(X, 1)
                            Liste(Say, 2) = Veri(X, 7)
                        Else
                            Liste(Dizi.Item(Veri(X, 1)), 2) = Liste(Dizi.Item(Veri(X, 1)), 2) + Veri(X, 7)
                        End If
                    End If
                Next
            Else
                Veri = Sh.Range("A2:C" & Son).Value
                For X = LBound(Veri, 1) To UBound(Veri, 1)
                    If Veri(X, 2) = Magaza_Kodu Then
                        If Not Dizi.Exists(Veri(X, 1)) Then
                            Say = Say + 1
                            Dizi.Add Veri(X, 1), Say
                            Liste(Say, 1) = Veri(X, 1)
                            Liste(Say, 2) = Veri(X, 3)
                        Else
                            Liste(Dizi.Item(Veri(X, 1)), 2) = Liste(Dizi.Item(Veri(X, 1)), 2) + Veri(X, 3)
                        End If
                    End If
                Next
            End If
        End Select
    Next
    
    If Say > 0 Then
        S1.Range("A2").Resize(Say, 2) = Liste
        S1.Columns.AutoFit
        MsgBox "Özet tablo hazırlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    End If
    
    Set S1 = Nothing
    Set Dizi = Nothing
End Sub

 

[tuvons]

@Korhan Ayhan gerçekten çok işime yaradı. Destekleriniz için çok teşekkür ederim. Ellerinize sağlık.