Birden fazla ölçüde göre sayfalar arası toplam alma

Katılım
4 Ocak 2010
Mesajlar
2,074
Excel Vers. ve Dili
OFFICE 2007 PRO TR - Win7 X64
Altın Üyelik Bitiş Tarihi
18.06.2019
Selamlar,

Sitede araştırma yaptım en son tek ölçüde göre toplam alma vardı sayfalar arası.
Benim Yapmak istediğim birden fazla ölçüde göre toplam almak .

Örnek dosya ekdedir.

Şimdiden Teşekkürler.
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ektedir.:cool:
Kod:
Option Base 1
Sub topla_59()
Dim z As Object, a(), myarr(), n As Long, sat As Long, i As Byte, sh As Worksheet
Dim sat2 As Integer, j As Long, deg As String
Sheets("Sayfa7").Select
Range("A4:C65536").ClearContents
sat2 = Cells(65536, "M").End(xlUp).Row
If sat2 < 2 Then Exit Sub
Set z = CreateObject("Scripting.Dictionary")
ReDim myarr(1 To 3, 1 To 65533)
For i = 2 To sat2
    Set sh = Sheets(Cells(i, "M").Value)
    sat = sh.Cells(65536, "B").End(xlUp).Row
    If sat > 3 Then
        a = sh.Range("B4:D" & sat).Value
        For j = 1 To UBound(a, 1)
            deg = a(j, 1) & "-" & a(j, 2)
            If Not z.exists(deg) Then
                n = n + 1
                z.Add deg, n
                myarr(1, n) = a(j, 1)
                myarr(2, n) = a(j, 2)
            End If
            myarr(3, z.Item(deg)) = myarr(3, z.Item(deg)) + a(j, 3)
        Next j
    End If
Next i
If n > 0 Then
    Erase a
    Application.ScreenUpdating = False
    ReDim Preserve myarr(1 To 3, 1 To n)
    Range("A4").Resize(n, 3) = Application.Transpose(myarr)
    Application.ScreenUpdating = True
    Set sh = Nothing
    MsgBox "Verielr akatarıldı" & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
Erase myarr
End Sub
 

Ekli dosyalar

Katılım
2 Ağustos 2010
Mesajlar
3
Excel Vers. ve Dili
MS Excel 2007 İngilizce
Selam,

Eklediğin dosyadan anladığım kadarıyla senin derdine Pivot Table'lar derman olabilir. Pivot Table'lar birden fazla Worksheet'ten bilgi derleyerek bunları tek bir tabloda birleştirebilirler. Her bir worksheet içerisindeki bilginin aynı formatta olma zorunluluğu var, satır ve sütun etiketleri aynı olmak zorunda. İngilizce versiyonda Pivot Table Wizard'ın kısa yolu Alt+D+P (aynı anda basmak için kendini yorma sırayla bassanda olur). Wizard dışında Pivot Table'ların bu özelliğine ulaşmanın benim bildiğim bir yolu yok.

Umarım verdiğim bilgi işine yaramıştır, kolay gelsin.
 
Katılım
4 Ocak 2010
Mesajlar
2,074
Excel Vers. ve Dili
OFFICE 2007 PRO TR - Win7 X64
Altın Üyelik Bitiş Tarihi
18.06.2019
Selamlar,

Evren hocam vermiş oldugunuz zaman ve emek için teşekkürler sağolun..
Hocam bir şey rica etsem kızmazsınız inşallah ..
hocam ben kodlara biraz uzak oldugum için pek anlayamadım rica etsem ....
formüller bi çözüm yolu varmıdır...

Sayın.Selimkalac sizede teşkkürler
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Selamlar,

Evren hocam vermiş oldugunuz zaman ve emek için teşekkürler sağolun..
Hocam bir şey rica etsem kızmazsınız inşallah ..
hocam ben kodlara biraz uzak oldugum için pek anlayamadım rica etsem ....
formüller bi çözüm yolu varmıdır...

Sayın.Selimkalac sizede teşkkürler
Formül konusunda uzman arkadaşlar sorunuza bakacaktır.
Ama size şunuda söyleyim.
Veri yığını çoğaldıkça formüller yüzünden dosyanız gün gelecek açılmayacak bile .Bence siz bu vba konusuna girseniz iyi yaparsınız.:cool:
 
Katılım
4 Ocak 2010
Mesajlar
2,074
Excel Vers. ve Dili
OFFICE 2007 PRO TR - Win7 X64
Altın Üyelik Bitiş Tarihi
18.06.2019
Selamlar,

Yurttaş hocam teşekkürler.
Evren hocam Kodlu çözüm içinde size bir daha teşekkür ederim.
 
Üst