formülü makroya çevirme

[spacebar]

değerli üstadlarım. ekteki dosyamda formülü makroya çevirmek istiyorum. A sutununda veri var ise I:L sutunları arasındaki hesaplamaları yapmayi istiyorum. bir tanesini makro kaydet ile yaptım ama diğerlerini yapamadım. yardımlarınız için teşekkür ederim.

 

[Muzaffer Ali]

Merhaba.
Sheet1 adlı sayfanın kod kısmına aşağıdaki kodları kopyalayıp çalıştırın.

Sub Test()
    Dim Say As Long, Bak As Long
    Dim syfEndex As Worksheet
    Dim Donem As Long
    Set syfEndex = Worksheets("Endeks")
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    For Bak = 2 To Say
        Donem = Year(Cells(Bak, "E")) * 100 + Month(Cells(Bak, "E"))
        If Donem <= syfEndex.Range("A2") Then
            Cells(Bak, "I") = syfEndex.Range("B198") / syfEndex.Range("B2")
        Else
            Cells(Bak, "I") = syfEndex.Range("B198") / syfEndex.Range("A:A").Find(what:=Donem, lookat:=xlWhole)(1, 2).Value
        End If
        Cells(Bak, "J") = Cells(Bak, "C") * Cells(Bak, "I")
        Cells(Bak, "K") = Cells(Bak, "D") * Cells(Bak, "I")
        Cells(Bak, "L") = (Cells(Bak, "J") - Cells(Bak, "K")) - (Cells(Bak, "C") - Cells(Bak, "D"))
    Next
End Sub

 

[spacebar]

üstad çok teşekkür ederim ellerinize sağlık mükemmel çalışıyor. ancak çok özür dilerim "G ve H" sutunundaki hesaplamayı da yapabilir miyiz.

 

[Muzaffer Ali]

Aşağıdaki kodu deneyin.

Sub Test()
    Dim Say As Long, Bak As Long
    Dim syfEndex As Worksheet
    Dim Donem As Long
    Set syfEndex = Worksheets("Endeks")
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    For Bak = 2 To Say
        Cells(Bak, "G") = Format(Left(Cells(Bak, "A"), 3) + Bak / 1000, "0,00")
        Cells(Bak, "H") = Format(Left(Cells(Bak, "A"), 3), "0")
        Donem = Year(Cells(Bak, "E")) * 100 + Month(Cells(Bak, "E"))
        If Donem <= syfEndex.Range("A2") Then
            Cells(Bak, "I") = syfEndex.Range("B198") / syfEndex.Range("B2")
        Else
            Cells(Bak, "I") = syfEndex.Range("B198") / syfEndex.Range("A:A").Find(what:=Donem, lookat:=xlWhole)(1, 2).Value
        End If
        Cells(Bak, "J") = Cells(Bak, "C") * Cells(Bak, "I")
        Cells(Bak, "K") = Cells(Bak, "D") * Cells(Bak, "I")
        Cells(Bak, "L") = (Cells(Bak, "J") - Cells(Bak, "K")) - (Cells(Bak, "C") - Cells(Bak, "D"))
    Next
End Sub

 

[spacebar]

üstad G sutununda formüldeki satır değeri gelmiyor.

 

[spacebar]

üstadım şu satırı düzeltince sorun çözüldü :

Cells(Bak, "G") = Format(Left(Cells(Bak, "A"), 3) + Bak / 1000, "000.000")

teşekkür ederim. sağlıklı günler dilerim.

 

[spacebar]

@Muzaffer Ali üstadım merhaba. uygulamada bir değişiklik oldu. o yüzden çalışmada da revize yapmamız gerekiyor. Data sayfasında J kolonunda bulunan formülün, hesapla makrosunda düzenlenmesi gerekiyor. yani hesapla makrosunda J sutunundaki kısımları yeniden yazmak gerekiyor. desteğiniz için şimdiden teşekkür ederim.