Satırları eşit aralığa bölme ve sayfalar arası veri aktarımı

[ciyager]

Merhabalar,
Ekte paylaştığım dosya da bulunan Güneşlenme Süresi sayfasının 10'ar günlük eşit aralıklara bölmeye çalışıyorum. Böldüğümüz her 10 günün ortalaması alarak sayfa birdeki yerlerine aktarmaya çalışıyorum yardımcı olabilir misiniz?

 

[ciyager]

merhabalar,
Yukarıda paylaştığım örnek ek dosyasında aşağıda bulunan kodu uyarlamak istiyorum. Satır ve sütunlarda hatalar oluşuyor. Kodu, örnek dosyada bulunan yerleşim düzenine göre uyarlamaya çalışıyorum ama hata veriyor. Düzeltmeler yaptım satır ve sütunlarda yıne olmadı. Yardımcı olabilir misiniz?

Sub test()
Dim son&, hesaplama, i&, ii&, haftason%, bas&

With Application
.ScreenUpdating = False
.EnableEvents = False
hesaplama = .Calculation
.Calculation = xlCalculationManual
End With

son = Cells(Rows.Count, 2).End(3).Row
For i = son To 3 Step -1
haftason = haftaBul(Int(Cells(i, 6).Value))
For ii = i - 1 To 2 Step -1
Cells(ii, 6).Select
If haftason <> haftaBul(Int(Cells(ii, 6).Value)) Then

bas = ii + 1
Rows(son + 1).Insert
With Cells(son + 1, 7)
.Formula = "=AVERAGE(G" & bas & ":G" & son & ")"
.Borders.Weight = xlMedium
.Interior.Color = vbYellow
End With
i = ii + 1
son = ii

Exit For

End If
Next ii
Next i
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = hesaplama
End With

End Sub

Function haftaBul(gun)
Select Case gun
Case Is > 20: haftaBul = 3
Case Is > 10: haftaBul = 2
Case Is > 0: haftaBul = 1
Case Else: haftaBul = 0
End Select
End Function