Genel Toplama Sayfasına Veri Çekme

[o2l3m]

Tarih formatlı diğer sayfalardan aynı kodlu ürünlerin toplamını nasıl çekebiliriz.
Bu formül ile her ay çok zaman alıyor. Makro ile mümkün müdür?

Teşekkürler.

 

[askm]

Sayfaların hepsi de aynı ne yapmak istediğinizi daha açık yazarsanız. Ya da örnek dosyanızda ona göre açıklarsanız yardımcı olmaya çalışalım.

 

[o2l3m]

Sheetlerdeki K-L-M Sütünda oaln verilerin toplamını ürün kodu bazında toplayarak listelemek.

Genel toplam sayfasında formül yazdım. Sanırım ne demek istedğimi daha iyi anlayacaksınız.

Teşekkürler,

 

[YUSUF44]

Aşağıdaki formül K3 hücresi için toplama işlemini veriyor. Ancak bu formülün doğru çalışması için aynı kodlu ürünlerin her sayfada aynı satırda olması gerekiyor. Formülü K3 hücresine yazdıktan sonra sağa ve aşağı kopyalayabilirsiniz:

=TOPLA('01.11.2017:03.12.2017'!K3)

 

[o2l3m]

Sayfalar her gün yeni oluşturuluyor. Ve ürün kodlarının sütundaki yerleri değişebiliyor. Böyle olunca formül işe yaramıyor. :-(
Formülü verinin nerden ne şekilde alındığını göstermek için koydum.

Sayfalardaki aynı ürünleri tarayacak ve toplamları getirecek bir makro çözebilir ancak..

 

[YUSUF44]

Aşağıdaki kodu bir modüle yapıştırıp deneyiniz:

Sub toplam()
Set s1 = Sheets("Genel Toplam")
sontop = WorksheetFunction.Max(3, s1.Cells(Rows.Count, "J").End(3).Row)
s1.Range("K3:M" & sontop) = ""
For i = 3 To sontop
    For sayfa = 1 To Sheets.Count
        If Sheets(sayfa).Name <> s1.Name Then
            songün = WorksheetFunction.Max(3, Sheets(sayfa).Cells(Rows.Count, "J").End(3).Row)
            If WorksheetFunction.CountIf(Sheets(sayfa).Range("J3:J" & songün), s1.Cells(i, "J")) > 0 Then
                s1.Cells(i, "K") = WorksheetFunction.SumIf(Sheets(sayfa).Range("J3:J" & songün), s1.Cells(i, "J"), Sheets(sayfa).Range("K3:K" & songün)) + s1.Cells(i, "K")
                s1.Cells(i, "L") = WorksheetFunction.SumIf(Sheets(sayfa).Range("J3:J" & songün), s1.Cells(i, "J"), Sheets(sayfa).Range("L3:L" & songün)) + s1.Cells(i, "L")
                s1.Cells(i, "M") = WorksheetFunction.SumIf(Sheets(sayfa).Range("J3:J" & songün), s1.Cells(i, "J"), Sheets(sayfa).Range("M3:M" & songün)) + s1.Cells(i, "M")
            End If
        End If
    Next
Next
End Sub

 

[o2l3m]

Çok teşekkürler Yusuf Bey

Genel toplam sayfasında olmayan bir ürün kodunun toplamını getirmiyor değil mi?
Peki onu nasıl getirebiliriz?
Arama veri getirme Genel toplamdaki ürünler üzerinden yapmazsa tam aradığım olacak aslında.

Teşekkürler

 

[YUSUF44]

Aşağıdaki gibi deneyiniz:

Sub toplam()
Set s1 = Sheets("Genel Toplam")
sontop = WorksheetFunction.Max(3, s1.Cells(Rows.Count, "J").End(3).Row)
s1.Range("J3:M" & sontop) = ""
For sayfa = 1 To Sheets.Count
    yeni = s1.Cells(Rows.Count, "J").End(3).Row + 1
    If Sheets(sayfa).Name <> s1.Name Then
        songün = WorksheetFunction.Max(3, Sheets(sayfa).Cells(Rows.Count, "J").End(3).Row)
        Sheets(sayfa).Range("J3:J" & songün).Copy s1.Cells(yeni, "J")
        sonyeni = s1.Cells(Rows.Count, "J").End(3).Row + 1
        s1.Range("J3:J" & sonyeni).RemoveDuplicates Columns:=1, Header:=xlYes
    End If
Next


For i = 3 To sontop
    For sayfa = 1 To Sheets.Count
        If Sheets(sayfa).Name <> s1.Name Then
            songün = WorksheetFunction.Max(3, Sheets(sayfa).Cells(Rows.Count, "J").End(3).Row)
            If WorksheetFunction.CountIf(Sheets(sayfa).Range("J3:J" & songün), s1.Cells(i, "J")) > 0 Then
                s1.Cells(i, "K") = WorksheetFunction.SumIf(Sheets(sayfa).Range("J3:J" & songün), s1.Cells(i, "J"), Sheets(sayfa).Range("K3:K" & songün)) + s1.Cells(i, "K")
                s1.Cells(i, "L") = WorksheetFunction.SumIf(Sheets(sayfa).Range("J3:J" & songün), s1.Cells(i, "J"), Sheets(sayfa).Range("L3:L" & songün)) + s1.Cells(i, "L")
                s1.Cells(i, "M") = WorksheetFunction.SumIf(Sheets(sayfa).Range("J3:J" & songün), s1.Cells(i, "J"), Sheets(sayfa).Range("M3:M" & songün)) + s1.Cells(i, "M")
            End If
        End If
    Next
Next
End Sub

 

[o2l3m]

Sanırım bir yerde sorun var.
Aşağıda anlatmaya çalıştım.

 

[YUSUF44]

Ben son gönderdiğiniz örnek dosyada makroyu çalıştırdığımda sarı olan "veriler gelmedi" dediğiniz hücrelere verileri getirdi.

Aynı kodun ikinci defa görünmesi ise yinelemeleri kaldırırken başlık var seçeneği seçilmiş. Bunu düzeltmek için

        s1.Range("[COLOR="Red"]J3[/COLOR]:J" & sonyeni).RemoveDuplicates Columns:=1, Header:=xlYes

satırını

        s1.Range("[COLOR="red"]J2[/COLOR]:J" & sonyeni).RemoveDuplicates Columns:=1, Header:=xlYes

olarak değiştirin.

 

[o2l3m]

Office 2016 kullanıyorum. Bende makroyu 2 defa peşpeşe çalıştırınca ancak tüm veriler geliyor.
Neden olabilir? Eke videoya bakabilirmisiniz?

 

[YUSUF44]

Ben de 2016 kullanıyorum.

Gönderdiğiniz Video sadece 604 kb ve görüntü yok.

 

[o2l3m]

Dosyayı yükledim.

http://s3.dosya.tc/server13/dg9s3q/1.avi.html

 

[Ziynettin]

Alternatif olarak da bu şekilde kullanabilirsiniz.

Sub toplam_al()
Dim s1 As Worksheet, s2 As Worksheet
Dim a(), b(), d As Object, son As Long
Dim i As Long, Say As Long, j As Byte, sat As Long
Set s1 = Sheets("Genel Toplam")
Set d = CreateObject("scripting.dictionary")
For j = 1 To Worksheets.Count
    Set s2 = Sheets(j)
    If Not s2.Name = s1.Name Then
        son = s2.Cells(Rows.Count, 10).End(3).Row
        a = s2.Range("J3:M" & son)
        For i = 1 To UBound(a)
            d(a(i, 1)) = ""
        Next i
    End If
Next j
Application.ScreenUpdating = 0
s1.Range("J3:M" & son).ClearContents
If d.Count > 0 Then
    ReDim b(1 To d.Count, 1 To UBound(a, 2))
    d.RemoveAll
    For j = 1 To Worksheets.Count
        Set s2 = Sheets(j)
        If Not s2.Name = s1.Name Then
            son = s2.Cells(Rows.Count, 10).End(3).Row
            a = s2.Range("J3:M" & son)
            For i = 1 To UBound(a)
                If Not d.exists(a(i, 1)) Then
                    Say = Say + 1
                    d(a(i, 1)) = Say
                    b(Say, 1) = a(i, 1)
                End If
                sat = d(a(i, 1))
                b(sat, 2) = b(sat, 2) + CDbl(a(i, 2))
                b(sat, 3) = b(sat, 3) + CDbl(a(i, 3))
                b(sat, 4) = b(sat, 4) + CDbl(a(i, 4))
            Next i
        End If
    Next j
    s1.[J3].Resize(Say, UBound(a, 2)) = b
End If
Application.ScreenUpdating = 1
MsgBox "işlem tamam.", vbInformation
End Sub