Tekrarlı listeden özet rapor oluşturmak

cavanoos · 16 Mart 2011

Merhaba arkadaşlar;

3000 satırlık veri bulunan excel dosyam var.Ekli tablomda basit bir örnek hazırladım.Yapmak istediğim işlem şudur.

Aynı gün içinde,aynı mağazanın toplamı ne kadar? Tablomdaki örnekte 01.01.2011 tarihinde cevahir mağazasının toplam tutarı 405.57 dir.Bütün bir veri için tarama yapacak ve bir özet çıkarmalı.

Bu işlemi çok basit bir şekilde özet tabloda yapabilirim.Ama sonrasında yapacağım diğer makrolu işlemlerim için sıkıntı yaratıyor.Alttoplam kullanarak yaptığımda ise sadece tek bir değişken istiyor benden bende ise tarih ve açıklama değişkeni var.

Yardım edebilir misiniz ?

mancubus · 16 Mart 2011

boş bir hücrede...

veri - özet tablo.
verilerininzin bulunduğu alanı seçin.
yerleşim: satır = tarih / sütun = mağaza / veri = tutar.

özet tablolar konusuna hakim değilseniz:
http://www.excel.web.tr/f60/zet-tablolar-p-vot-table-t3036.html

cavanoos · 16 Mart 2011

Macnubus;

Özet tablo olarak yapabilirim ama alacağım sonuç,istediğim gibi olmayacaktır.

01.01.2011 Cevahir 405.57
01.01.2011 Kale 182.46
02.01.2011 Starcity 32.69

buna benzer sonuçları A sütununda tarih B sütununda Mağaza İsmi C sütununda toplam olarak alamam

Yukarıdaki şekilde sonucu nasıl alabilirim ?

Korhan Ayhan · 16 Mart 2011

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Özet tablo yöntemi ile hazırlanmıştır.

cavanoos · 16 Mart 2011

Korhan Bey;

İstediğim bunun gibi bir şey ama her satırda tarih çıkması için ne yapabiliriz ?

Korhan Ayhan · 16 Mart 2011

Selamlar,

Özet tablonun yapısı gereği sanırım bu isteğiniz yapılamıyor. Yani tarihleri detaylandırırsanız bu seferde isimler gruplanıyor. Satır bazlı özet bir tablo istiyorsanız ya formüllerle çözüm aramalısınız ya da makro ile çözüm aramalsınız.

cavanoos · 16 Mart 2011

Korhan Bey;

İlgilendiğiniz için teşekkür ederim.Bende çözüm için ne yapabilirm diye düşünüyordum.Ancak makro kodu yazılarak olacak galiba.Aklımdaki şudur;

1-Yine özet tablo yapayım.Sizin yaptığınız gibi düzenleyeyim.
2-Sizin yaptığınız özet tabloda,bir günde bir tane tarih çıkıyor.Biz ilk tarihi kopyalayıp,Bir sonraki tarihe kadar olan bölüme yapıştırabilir miyiz.Yani bunun için nasıl bir makro kodu yazmalıyız ?

Tahmin ediyorum ki;İlk satırı kopyaladıktan sonra,bir alt satıra indiğinde,eğer hücre içerisinde değer varsa kopyalama,eğer yoksa kopyala tarzı bir komut olmalı.

Bu konuda yardım edebilir misiniz ?
Ya da makro bölümünde mi konu açayım ?

Korhan Ayhan · 16 Mart 2011

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Uygulanan kod; (Boş bir modüle uygulayınız.)

Kod:

Option Explicit
 
Sub ÖZET_RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet, Son_Satır As Long, Formül As String
    
    Set S1 = Sheets("fin")
    Set S2 = Sheets("Sayfa1")
    
    Application.ScreenUpdating = False
    S2.Range("A:C").ClearContents
    S1.Columns("A:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S2.Range("A1"), Unique:=True
    Son_Satır = WorksheetFunction.CountA(S1.Columns(1))
    S2.Select
    S2.Range("C1") = "TUTAR"
    Formül = "=SUMPRODUCT((" & S1.Name & "!A$2:A$65536=A2)*(" & S1.Name & "!B$2:B$65536=B2)*(" & S1.Name & "!C$2:C$65536))"
    S2.Range("C2") = Replace(Formül, 65536, Son_Satır)
    S2.Range("C2").AutoFill Destination:=S2.Range("C2:C" & S2.Range("A65536").End(3).Row)
    S2.Range("C2:C" & S2.Range("A65536").End(3).Row).Value = S2.Range("C2:C" & S2.Range("A65536").End(3).Row).Value
    S2.Columns("A:C").EntireColumn.AutoFit
    Application.ScreenUpdating = True
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

cavanoos · 16 Mart 2011

Korhan Bey;

Çok teşekkür ederim.Aradığım tam olarak buydu.

Size ikinci bir sorum daha olacak.Olabilirse daha süper olacak.Aynı gün içinde,aynı mağazanın toplam tutarlarını getirdiniz.Bu tutarların içinde (-) karakterli ve (+) karakterli toplam satırları var.

Cevahir mağazası 02.01.2011 tarihindeki toplam artı tutarlar ve toplam eksi tutarlar diye 2 satır halinde yapabilir miyiz ?

Korhan Ayhan · 16 Mart 2011

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Uygulanan kod;

Kod:

Option Explicit
 
Sub ÖZET_RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet, Son_Satır As Long
    Dim Formül_1 As String, X As Long, Say As Long, Formül_2 As String, Formül_3 As String
    
    Set S1 = Sheets("fin")
    Set S2 = Sheets("Sayfa1")
    
    Application.ScreenUpdating = False
    S2.Range("A:C").ClearContents
    S1.Columns("A:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S2.Range("A1"), Unique:=True
    Son_Satır = WorksheetFunction.CountA(S1.Columns(1))
    S2.Select
    S2.Range("C1") = "TUTAR"
    Formül_1 = "=SUMPRODUCT((" & S1.Name & "!A$2:A$65536=A2)*(" & S1.Name & "!B$2:B$65536=B2)*(" & S1.Name & "!C$2:C$65536>0)*(" & S1.Name & "!C$2:C$65536))"
    S2.Range("C2") = Replace(Formül_1, 65536, Son_Satır)
    S2.Range("C2").AutoFill Destination:=S2.Range("C2:C" & S2.Range("A65536").End(3).Row)
    S2.Range("C2:C" & S2.Range("A65536").End(3).Row).Value = S2.Range("C2:C" & S2.Range("A65536").End(3).Row).Value
    
    For X = Range("A65536").End(3).Row To 2 Step -1
        Formül_2 = "=SUMPRODUCT((" & S1.Name & "!A$2:A$65536=" & CLng(Cells(X, 1)) & ")*(" & S1.Name & "!B$2:B$65536=""" & Cells(X, 2) & """)*(" & S1.Name & "!C$2:C$65536<0))"
        Say = Evaluate(Replace(Formül_2, 65536, Son_Satır))
        If Say > 0 Then
            Rows(X + 1).Insert
            Cells(X + 1, 1) = Cells(X, 1)
            Cells(X + 1, 2) = Cells(X, 2)
            Formül_3 = "=SUMPRODUCT((" & S1.Name & "!A$2:A$65536=" & CLng(Cells(X, 1)) & ")*(" & S1.Name & "!B$2:B$65536=""" & Cells(X, 2) & """)*(" & S1.Name & "!C$2:C$65536<0)*(" & S1.Name & "!C$2:C$65536))"
            Cells(X + 1, 3) = Evaluate(Replace(Formül_3, 65536, Son_Satır))
        End If
    Next
    
    S2.Columns("A:C").EntireColumn.AutoFit
    Application.ScreenUpdating = True
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

cavanoos · 17 Mart 2011

Tek kelime ile süperrrrrr

Saolun...

cavanoos · 17 Mart 2011

Korhan Bey;

Hazırlamış olduğunuz makro kodundaki sayfa sekmelerinin isimlerini değiştirdim.

Öncesi;

Set S1 = Sheets("fin")
Set S2 = Sheets("Sayfa1")

Sonrası;

Set S1 = Sheets("Pos Tutarları")
Set S2 = Sheets("Pos Tutarları-2")

Öncesinde sorun yok iken,sadece sayfa sekmelerini değiştirdim.Hata verdi.

Say = Evaluate(Replace(Formül_2, 65536, Son_Satır))

Hatayı bu satırda verdi.Siz sayfa sekmelerini değişken olarak tanımladınız.Dolayısı ile makro kodunun içinde tek bir yerde sayfa sekmelerinin isimleri geçiyordu.Bende onları değiştirdim.Ama şimdi çalışmıyor.Başka bir şeyde yapmadım.

Yardım edebilir misiniz

Korhan Ayhan · 17 Mart 2011

Selamlar,

Sayfa isimlerinde kullandığınız boşluklardan dolayı sorun yaşıyorsunuz. Aşağıdaki şekilde düzeltip deneyin.

Kod:

Set S1 = Sheets("Pos_Tutarları")
Set S2 = Sheets("Pos_Tutarları_2")

cavanoos · 17 Mart 2011

Korhan bey;

Düzeldi çok teşekkür ederim.Bilginiz olsun - işaretinden kaynaklanıyor.Çünkü önce pos-tutarları yazdım olmadı.Sonra postutarları yazdım oldu.

karanx · 5 Temmuz 2013

Bu örnekteki makroyu ben de kullandım..Ve çok faydalı oldu,ancak işin her ne kadar mantığına aykırı da olsa ,ekteki dosyada da görüleceği gibi veri tek oldugu zaman hata veriyor..Benim bu makroyu bu şekilde de kullanmam gerekiyor ...Ne yapamam gerekir ? Teşekkürler.

karanx · 5 Temmuz 2013

güncel.......

Korhan Ayhan · 6 Temmuz 2013

Aşağıdaki kodu deneyiniz.

Kod:

Option Explicit

Sub ÖZET_RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet, Son_Satır As Long, Formül As String
    
    Set S1 = Sheets("fin")
    Set S2 = Sheets("Sayfa1")
    
    Application.ScreenUpdating = False
    S2.Range("A:C").ClearContents
    S1.Columns("A:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S2.Range("A1"), Unique:=True
    Son_Satır = WorksheetFunction.CountA(S1.Columns(1))
    S2.Select
    S2.Range("C1") = "TUTAR"
    Formül = "=SUMPRODUCT((" & S1.Name & "!A$2:A$65536=A2)*(" & S1.Name & "!B$2:B$65536=B2)*(" & S1.Name & "!C$2:C$65536))"
    S2.Range("C2") = Replace(Formül, 65536, Son_Satır)
    If S2.Range("A65536").End(3).Row > 2 Then
        S2.Range("C2").AutoFill Destination:=S2.Range("C2:C" & S2.Range("A65536").End(3).Row)
        S2.Range("C2:C" & S2.Range("A65536").End(3).Row).Value = S2.Range("C2:C" & S2.Range("A65536").End(3).Row).Value
    Else
        S2.Range("C2").Value = S2.Range("C2").Value
    End If
    S2.Columns("A:C").EntireColumn.AutoFit
    Application.ScreenUpdating = True
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Tekrarlı listeden özet rapor oluşturmak

cavanoos

Ekli dosyalar

mancubus

Destek Ekibi

cavanoos

Korhan Ayhan

Administrator

Ekli dosyalar

cavanoos

Korhan Ayhan

Administrator

cavanoos

Korhan Ayhan

Administrator

Ekli dosyalar

cavanoos

Korhan Ayhan

Administrator

Ekli dosyalar

cavanoos

cavanoos

Korhan Ayhan

Administrator

cavanoos

karanx

Ekli dosyalar

karanx

Korhan Ayhan

Administrator