Soru Mevcut Formülü Tüm Sayfaya Uygulama

[mehmetd]

Sn. Arkadaşlar iyi günler
ekteki örnek dosyamda da görüleceği üzere her cari kod değişimde alt kısımda bir formül yer alıyor.
Bu formülleri tek tek her her cari kodu altına uygulama çok zor. ve bu liste güncellenecek.
Bunu nasıl her cari kod değişiminde uygulayabilirim. visual basic kodlarıyla da olabilir.
yardımlarınız için şimdiden teşekkür ederim.

 

[ÖmerBey]

Merhaba,
Dosyanızın yedeğini aldıktan sonra deneyiniz.

Sub kod()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("B2:B" & Cells(Rows.Count, "B").End(3).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
b = 2
a = b
Do
    a = a + 1
    If Cells(a, "B") <> Cells(a - 1, "B") Then
        s = a - 1
        Rows(a).Insert
        Cells(a, "H").Formula = "=IFERROR(SUMPRODUCT((((F" & b & ":F" & s & ")-TODAY())*(H" & b & ":H" & s & ")))/SUMPRODUCT((H" & b & ":H" & s & ")),0)"
        Cells(a, "I").Formula = "=IFERROR(SUMPRODUCT((I" & b & ":I" & s & ">0)*(F" & b & ":F" & s & "<=TODAY())*((TODAY()-(A" & b & ":A" & s & "))*(I" & b & ":I" & s & ")))/SUMPRODUCT((F" & b & ":F" & s & "<=TODAY())*(I" & b & ":I" & s & ")),0)"
        Cells(a, "J").Formula = "=+H" & a & "+I" & a
        With Range("A" & a & ":J" & a)
            .Interior.Color = vbYellow
            .NumberFormat = "#,##0_ ;[Red]-#,##0"
        End With
        a = a + 1
        b = a
    End If
Loop While Cells(a, "B") <> ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Not: Lütfen görsellikle alakalı düzenleme talep etmeyiniz.

 

[mehmetd]

Sn. Ömer Bey çok teşekkür ediyorum. Sağlıklı günler diliyorum.