Formülü makroya dönüştürme problemi

[SadiSerdari]

Arkadaşlar ekteki dosyada problemimi anlatmaya çalıştım. Hücredeki formülü makro olarak yapmak istiyorum ancak aynı sonuca ulaşamadığım gibi sonuç hücreye de yansımıyor.

 

[SadiSerdari]

Belki bir başka ardaşında işine yarayabilir kodları ekliyorum, çözüme ulaştım. İlgilenen arkadaşlara Teşekkürler.

Sub Hesapla1()

    Dim SonSat1 As Long, SonSat2 As Long, Sat As Long
    SonSat1 = Cells(Rows.Count, 4).End(xlUp).Row

        For i = 4 To SonSat1

            Sat = i

            Cells(i, "F") = Round(((Cells(Sat, "D") * 0.4) + (Cells(Sat, "E") * 0.6)), 0)

            Sat = Sat + 1

        Next

    Cells(Sat, "F") = Round(WorksheetFunction.Sum(Range("F4" & ":F" & SonSat1)) / WorksheetFunction.CountA(Range("F4" & ":F" & SonSat1)), 2)
    Cells(Sat + 1, "F") = Round(Application.WorksheetFunction.StDev(Range("F4" & ":F" & SonSat1)), 2)
    [L4] = Round(WorksheetFunction.Sum(Range("F4" & ":F" & SonSat1)) / WorksheetFunction.CountA(Range("F4" & ":F" & SonSat1)), 2)

    
    SonSat2 = Cells(Rows.Count, 6).End(xlUp).Row
   
        For Sat = 4 To SonSat2

            Cells(Sat, 7) = Round((Cells(Sat, 6) - Cells(SonSat2 - 1, 6)) / WorksheetFunction.StDev(Range("F4:F" & SonSat2 - 2)) * 10 + 50, 2)

        Next Sat
        
    Dim Ksl As Long, Dgr As Integer
    Ksl = Cells(Rows.Count, 6).End(xlUp).Row - 1
    
    For Sat = 4 To Ksl
    
    Dgr = Cells(Sat, "G").Value
        
        If Cells(Ksl, "F") < 42.49 Then
        
            Cells(Sat, "H") = KrediDg(Dgr)
        
        ElseIf Cells(Ksl, "F") < 47.49 Then
        
            Cells(Sat, "H") = KrediDg(Dgr)
 
        ElseIf Cells(Ksl, "F") < 52.49 Then
        
            Cells(Sat, "H") = KrediDg(Dgr)
            
        ElseIf Cells(Ksl, "F") < 57.49 Then
        
            Cells(Sat, "H") = KrediDg(Dgr)
            
        ElseIf Cells(Ksl, "F") < 62.49 Then
        
            Cells(Sat, "H") = KrediDg(Dgr)
            
        ElseIf Cells(Ksl, "F") < 69.99 Then
        
            Cells(Sat, "H") = KrediDg(Dgr)
            
        ElseIf Cells(Ksl, "F") < 79.99 Then
        
            Cells(Sat, "H") = KrediDg(Dgr)
            
        Else
        
        End If
        
    Next
    
Dim SnSt As Long, Str As Long
SnSt = Cells(Rows.Count, 7).End(xlUp).Row - 2

For Str = 4 To SnSt

        If Cells(Str, 8) = "FF" Then
        
        Cells(Str, 9) = "Kaldı"
        Cells(Str, 9).Interior.ColorIndex = 38
        
        Else
        
        Cells(Str, 9) = "Geçti"
        
        End If
        
        Next
        
End Sub

Function KrediDg(ByVal hcra As Variant)

        Select Case hcra

            Case 57, 59, 61, 63, 65, 67, 68, 69, 71

                KrediDg = "AA"

            Case 52, 54, 56, 58, 60, 62, 64, 66

                KrediDg = "BA"

            Case 47, 49, 51, 53, 55, 57, 59, 61

                KrediDg = "BB"

            Case 42, 44, 46, 48, 50, 52, 54, 56

                KrediDg = "CB"

            Case 37, 39, 41, 43, 45, 47, 49, 51

                KrediDg = "CC"

            Case 32, 34, 36, 38, 40, 42, 44, 46

                KrediDg = "DC"

            Case 27, 29, 31, 33, 35, 37, 41, 43

                KrediDg = "DD"

            Case 0 To 26

                KrediDg = "FF"

        End Select
        
End Function