L
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub toplamalar()
Dim i As Long, sat As Long, deg As String, myarr() As Variant, z As Object
Dim a As Long
Sheets("Bordro").Select
Application.ScreenUpdating = False
Range("E2:G65536").ClearContents
sat = Cells(65536, "A").End(xlUp).Row
ReDim myarr(1 To 3, 1 To sat)
Set z = CreateObject("Scripting.Dictionary")
For i = 2 To sat
deg = Cells(i, "A").Value & "-" & Cells(i, "C").Value
If Not z.exists(deg) Then
a = a + 1
z.Add deg, a
myarr(1, a) = Cells(i, "A").Value
myarr(2, a) = Cells(i, "C").Value
End If
myarr(3, z.Item(deg)) = myarr(3, z.Item(deg)) + 1
Next i
If a > 0 Then Range("E2").Resize(z.Count, 3) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "Toplamlar çıkarıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub