- Katılım
- 14 Ağustos 2013
- Mesajlar
- 7
- Excel Vers. ve Dili
- office 2010 TR
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub daylight()
Application.ScreenUpdating = False
Sheets(2).Range("b2:c1000").ClearContents
Range("a2:b1000").Sort key1:=Range("a2")
For x = 2 To 1000
If Cells(x, 1) = "" Then GoTo gel
ben = Cells(x, 2)
sen = 1
For y = x + 1 To 1000
If Cells(x, 1) = Cells(y, 1) Then
ben = ben + Cells(y, 2)
sen = sen + 1
Else
Sheets(1).Cells(x, 1).Copy
Sheets(2).Cells(Sheets(2).[b1000].End(3).Row + 1, 2).PasteSpecial
Sheets(2).Cells(Sheets(2).[c1000].End(3).Row + 1, 3) = ben / sen
ben = 0
x = x + sen - 1
Exit For
End If
Next y
Next x
gel:
Sheets(2).Select
hey = Sheets(2).[b1000].End(3).Row + 1
Sheets(2).Cells(hey, 2) = "Toplam"
Sheets(2).Cells(hey, 3) = WorksheetFunction.Sum(Sheets(2).Range("c" & 2 & ":c" & hey))
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub