Pivot tablosu ilgili detayı getirme

[onderka]

Arkadaşlar Merhaba;

Excel'de elimde 20.000 satırlık bir veri var bu veri aynı grupta gruplandırdığım zaman 2000 gruba ayrılıyor.

Size sormak istediğim ilk olarak bu datayı başlıkları gruplar halinde ayırmak ikinci olarak her grup içinde sıra numarası vermek ve gruplar arasında satır boşluğu yapmak istiyorum yardımcı olursanız sevinirim;

 

[Korhan Ayhan]

Örnek dosyanızı aşağıdaki siteye yükleyip linkini foruma ekler misiniz?

http://s4.dosya.tc/

 

[onderka]

Hocam link aşşağıda Main Data sheet'inde beyanname numarasına göre gruplandırma yapmak istiyorum aynı zamanda gruplandırmaya her gruba içinde sıra numarası vermek ve gruplar arasına satır boşluğu yaparsam iyi olacak

Aynı zamanda yan sheette bir pivot table var ordada yine işin içinden çıkamadığım bir sorunu işaretleyerek konuşma balonuna yazdım sorunumu vaktiniz varsa onada bakabilirsiniz sanırsam makroda çalışmadan benim olacak gibi değil heralde tabi uzman sizsiniz benim excel bilgim tükendi burda

http://s2.dosya.tc/server2/en1at5/Ek12.xlsx.html

 

[Eyupcan Tasar]

Merhaba;

Beyan numarasına göre gruplama için "ekle" menüsünden "dilimleyici" ekleyerek pivotta istediğiniz filtrelemeyi sağladım. Fakat Delta kısmı pivota dahil değil sanıyorum. Sonradan eklenmiş. Pivot yanındaki bağlı olmayan hücreyle sıralama yapılamıyor. Eğer bu sütunları pivota dahil ederseniz, ikinci bir dilimleyici ile farklı gruplama elde edebilirsiniz.

http://s2.dosya.tc/server2/wx3565/Ek12.xlsx.html

 

[onderka]

1.Hocam teşekkür ederim ama istediğim tam olarak o değildi yani gruplandırmayı pivot sayfasına değil main data sayfasına istedim. İsterseniz bir daha gözden geçirin yeni yüklediğim dosyayı bir kaç satırı manuel olarak ben girdim örnek olsun diye ama takdir edersiniz 20.000 satır var hepsini elle girmem mümkün değil bunu nasıl formülize ederim acaba

http://s3.dosya.tc/server3/l76jqo/Ek12_-_Kopya.xlsx.html

 

[Eyupcan Tasar]

1.Hocam teşekkür ederim ama istediğim tam olarak o değildi yani gruplandırmayı pivot sayfasına değil main data sayfasına istedim. İsterseniz bir daha gözden geçirin yeni yüklediğim dosyayı bir kaç satırı manuel olarak ben girdim örnek olsun diye ama takdir edersiniz 20.000 satır var hepsini elle girmem mümkün değil bunu nasıl formülize ederim acaba

http://s3.dosya.tc/server3/l76jqo/Ek12_-_Kopya.xlsx.html

Merhaba;

Yapmak istediğinizi anladım. İstediğiniz liste farklı bir sayfada olmak koşuluyla yapılabilir.Özellikle İNDİS formülüyle bilgiler sorgulanabilir. Ancak gerekli formülüzasyon oldukça karışık bir birleşik formül olacaktır tahminimce.
Maalesef ki benim o kadar bilgim yok kusuruma bakmayın. Ama eminim ki hocalarım size yardımcı olacaklardır.
(Elimde bir örnek var şu an inceliyorum, bir çözüm getirebilirsem mutlaka sizinle paylaşırım, eğer anlarım diyorsanız özelden mail yazarsanız dosyayı gönderebilirim.)

 

[Korhan Ayhan]

Gruplandırma için aşağıdaki kodu deneyiniz.

Option Explicit

Sub GRUPLANDIR()
    Dim S1, X, Son, Bul, SatirA, SatirB, Say, Zaman, Liste(), Veri, Aranan
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    If Range("A1") <> "GRUP" Then
        Range("A:B").Insert
        Range("A1") = "GRUP"
        Range("B1") = "SIRA"
    End If
    
    Set S1 = Sheets("Main Data")
    Son = S1.Cells(S1.Rows.Count, 4).End(3).Row
    
    Liste = S1.Range("D2:D" & Son).Value
    
    Set Veri = CreateObject("Scripting.Dictionary")
    
    For X = 1 To UBound(Liste, 1)
        Aranan = Liste(X, 1)
        If Not Veri.Exists(Aranan) Then
            Say = Say + 1
            Veri.Add Aranan, Say
        End If
    Next
    
    Say = Veri.Count
    
    For X = Son To 2 Step -1
        If Cells(X, 4) <> Cells(X - 1, 4) Then
            Rows(X).Insert
            Set Bul = Range("D:D").Find(Cells(X + 1, 4), , , xlWhole)
            If Not Bul Is Nothing Then
                SatirA = Bul.Row
                SatirB = Bul.Row + WorksheetFunction.CountIf(Range("D:D"), Cells(X + 1, 4)) - 1
            End If
            Range("A" & SatirA & ":A" & SatirB) = "Grup " & Say
            Say = Say - 1
            Range("B" & SatirA) = 1
            If SatirB > SatirA Then
            Range("B" & SatirA).AutoFill Destination:=Range("B" & SatirA & ":B" & SatirB), Type:=xlFillSeries
            End If
        End If
    Next

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00")
End Sub

 

[Korhan Ayhan]

Özet tablonun detay raporunu oluşturmak için aşağıdaki kodu deneyiniz.

Option Explicit

Sub DETAY_RAPORU()
    Dim S1, S2, X, Son, Satir, Zaman
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Pivot Table")
    Son = S1.Cells(S1.Rows.Count, "F").End(3).Row
    Satir = 1
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Detaylı Rapor").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Sheets.Add , S1
    ActiveSheet.Name = "Detaylı Rapor"
    Set S2 = Sheets("Detaylı Rapor")
    
    For X = 5 To Son
        If IsNumeric(S1.Cells(X, "F")) Then
            If S1.Cells(X, "F") = 0 Then
                S1.Cells(X, "C").ShowDetail = True
                Selection.Copy S2.Cells(Satir, 1)
                On Error Resume Next
                Application.DisplayAlerts = False
                ActiveSheet.Delete
                Application.DisplayAlerts = True
                On Error GoTo 0
                Satir = S2.Cells(S2.Rows.Count, 1).End(3).Row + 2
            End If
        End If
    Next

    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00"), vbInformation
End Sub

 

[onderka]

Korhan hocam çok teşekkür edeim vallahi günlerce sürecek işi yadığınız kod 21 saniyede halletti nasıl teşekkür ederim bilmiyorum