mükerrer kayıtların toplanması

[SOYOLA]

ekte örneğini verdiğim dosyada mükerrer olanların toplanarak toplam sayfasına yazılmasını nasıl sağlarım
saygılarımla

 

[Ali]

Özet Tabloyu denediniz mi? Sizin sorunuzu çözer.

Excel Dersanesi kısmını bir inceleyiniz.

.

 

[Orion1]

Dosyanız ektedir.

Sub mukerrer_topla()
Dim sh As Worksheet, sat As Long, i As Long, z As Object, deg As String
Dim vkey, myarr
Sheets("toplam").Select
Application.ScreenUpdating = False
Range("A6:C65536").ClearContents
Set z = CreateObject("scripting.dictionary")
For Each sh In Worksheets
    If sh.Name <> ActiveSheet.Name Then
        sat = sh.Cells(65536, "A").End(xlUp).Row
        For i = 6 To sat
            deg = sh.Cells(i, "A").Value & "-" & sh.Cells(i, "B").Value
            If Not z.exists(deg) Then
                z.Add deg, sh.Cells(i, "C").Value
                Else
                z.Item(deg) = z.Item(deg) + sh.Cells(i, "C").Value
            End If
        Next i
    End If
Next sh
sat = 6
For Each vkey In z
    myarr = Split(vkey, "-")
    Cells(sat, "A").Value = myarr(0)
    Cells(sat, "B").Value = myarr(1)
    Cells(sat, "C").Value = z.Item(vkey)
    sat = sat + 1
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı" & vbLf & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
    


End Sub

 

[SOYOLA]

ilgilenen arkadaşlara teşekkür ederim