Aynı ayları bulup toplamları aldırmak

[haso_excel]

Merhaba arkadaşlar,
Ekteki dosyadaki bilgiler ışığında F kolonundaki vadelerle G kolonundaki tutarlar arasında hesaplama yaparak tüm faturaların vadesini heaplamak için aşağıdaki kodu kullanıyorum.
Amacım, aynı işlemi F kolonuna göre sıralayıp. her ayı kendi içinde toplamlarını alııp, her ay için I ve J kolonunda yaptığım işlemleri yapmak. Örnek dosya sheetin de var. Yardımlarınız için şimdiden çok teşekkür ederim.

Sub adat()

Range("I1").Formula = "=Today()"
Dim i As Integer
Dim k As Integer

For i = 2 To WorksheetFunction.CountA(Range("G:G"))
If Cells(i, 7).Value > 0 Then
Cells(i, 9).Value = Cells(i, 6) - Range("ı1")
ElseIf Cells(i, 7).Value < 0 Then
Cells(i, 9).Value = Cells(i, 6) - Range("ı1")
End If

For k = 2 To WorksheetFunction.CountA(Range("I:I"))
If Cells(i, 9).Value > 0 Then
Cells(i, 10).Value = Cells(i, 9) * Cells(i, 7)
ElseIf Cells(i, 9).Value <= 0 Then
Cells(i, 10).Value = Cells(i, 9) * Cells(i, 7)

End If

Next k
Next i
Columns("J:J").Style = "Comma"
SONH = [G65536].End(3).Row
'Range("g" & SONH) = (WorksheetFunction.Sum(Range("g2:g" & SONH)))
SONHf = [J65536].End(3).Row
Range("j" & SONHf + 1) = (WorksheetFunction.Sum(Range("j2:j" & SONHf)))
Range("g" & SONH + 2) = (WorksheetFunction.Sum(Range("j2:j" & SONH)) / 2) / (WorksheetFunction.Sum(Range("g2:g" & SONH)) / 2) + [i1].Value

'Columns("I:J").Select
'Range("I22").Activate
'Selection.EntireColumn.Hidden = True

Columns("G:G").ColumnWidth = 14.57
Columns("G:G").EntireColumn.AutoFit

MsgBox " İŞLEM TAMAM"
Range("g" & SONH + 2).Select

With ActiveCell.Font
    .Bold = True
    .Italic = True
    .ColorIndex = 3
End With
Selection.NumberFormat = "dd/mm/yyyy"
Range("g" & SONH + 2).Select
ActiveCell.Offset(0, 1).Range("a1").Value = "ORTAK VADE"
MsgBox "İŞLEM TAMAM"


'ActiveCell = Date$
'ActiveCell = FORMAT
'Range("g" & SONH + 2).Value = (Range("j" & SONH) / 2) / (Range("g" & SONH) / 2)+
'Range("g" & SONH + 2).Value = Range("j" & SONH) / Range("g" & SONH)
End Sub

 

[haso_excel]

Sırlama işini aşağıdaki kod ile hallettim arkadaşlar,

Sub sırala()
Dim alan As Long
alan = Cells(65536, "f").End(xlUp).Row
Range("a1:j" & alan).Activate
Range("A2:j" & alan).Sort key1:=Range("f2"), ORDER1:=xlAscending

End Sub

F kolonuna göre sıraladım. Şimdi F kolonunda ay bazında da kontrol yapmak istiyorum, yani F2 den başlayarak f2 ay=f3 ay ise devam eşit değilse bir sonraki satıra insert row yapacak. Sonra tekrar kaldığı yerden ay kontrolü yapıp F kolonunun sonuna kadar gidecek.

 

[haso_excel]

Günlerin F kolonundaki kontrolü için aşağıdaki kodu yazdım, fakat ay eşitse nasıl yazacağım. Yardımcı olurmusunuz.

Sub ay_kontrol()
Dim i As Date
For i = 2 To WorksheetFunction.CountA(Range("a:a"))
If Cells(i, 6).Value = Cells(i + 1, 6) Then
Cells(i, 9).Value = Cells(i, 6) * Cells(i, 7)
'Else: farklı ay olanı bulduğunda iki ay arasına bir row açacak
End If
Next i
End Sub