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

ciyager

Altın Üye
Katılım
22 Eylül 2022
Mesajlar
10
Excel Vers. ve Dili
excel 2016, türkçe
Altın Üyelik Bitiş Tarihi
22-09-2027
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?
 

Ekli dosyalar

ciyager

Altın Üye
Katılım
22 Eylül 2022
Mesajlar
10
Excel Vers. ve Dili
excel 2016, türkçe
Altın Üyelik Bitiş Tarihi
22-09-2027
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
 
Üst