taksitlendirme tablosu

[yalovam77]

Merhaba değerli üsdatlarım taksitlendirme ile ilgili bir tablo var hesaplamaları makro ile yaptırmak mümkünmüdür açıklamaları ekte gönderdiğim belgeye yazdım. Teşekkürler

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub kredi()
Set s1 = Sheets("Sayfa1")
son = s1.Cells(Rows.Count, "C").End(3).Row
s1.Activate
If son > 4 Then
    s1.Range("C5:H" & son).ClearContents
End If
If s1.[C1] = "" Then
    MsgBox "Lütfen toplam borç tutarını giriniz!", vbExclamation
    [C1].Select
    Exit Sub
ElseIf s1.[D1] = "" Then
    MsgBox "Lütfen toplam taksit sayısını giriniz!", vbExclamation
    [D1].Select
Exit Sub
ElseIf IsNumeric(s1.[C1]) = False Then
    MsgBox "Lütfen toplam borç tutarını sayısal olarak giriniz!", vbExclamation
    [C1].Select
    Exit Sub
ElseIf IsNumeric(s1.[D1]) = False Then
    MsgBox "Lütfen toplam taksit sayısını tamsayı olarak giriniz!", vbExclamation
    [D1].Select
    Exit Sub
Else
    borc = [C1]
    taksitsay = [D1]
    taksit = Round(borc / taksitsay, 2)
    
    Range("C5:C" & taksitsay + 4) = Date
    [D5] = taksit
    If Day(Date) <= 15 Then
        [E5] = DateSerial(Year(Date), Month(Date), 15)
    Else
        [E5] = DateSerial(Year(Date), Month(Date) + 1, 15)
    End If
    [F5] = [E5] - [C5]
    [G5] = [F5] * 9 * [D5] / 36000
    [H5] = [D5] + [G5]
    If taksitsay > 1 Then
        ay = 4
        For i = 2 To taksitsay
            Cells(ay + i, "D") = taksit
            Cells(ay + i, "E") = DateSerial(Year(Cells(3 + i, "E")), Month(Cells(3 + i, "E")) + 1, 15)
            Cells(ay + i, "F") = Cells(ay + i, "E") - Cells(ay + i, "C")
            Cells(ay + i, "G") = Cells(ay + i, "F") * 9 * Cells(ay + i, "D") / 36000
            Cells(ay + i, "H") = Cells(ay + i, "D") + Cells(ay + i, "G")
        Next
    End If
End If
enson = Cells(Rows.Count, "C").End(3).Row
odenen = WorksheetFunction.Sum(Range("D5:D" & enson))
If odenen > borc Then
    fark = odenen - borc
    Cells(enson, "D") = Cells(enson, "D") - fark
Else
    fark = borc - odenen
    Cells(enson, "D") = Cells(enson, "D") + fark
End If
Cells(enson, "G") = Cells(enson, "F") * 9 * Cells(enson, "D") / 36000
Cells(enson, "H") = Cells(enson, "D") + Cells(enson, "G")

End Sub

 

[yalovam77]

Merhaba üstadım ilginize teşekkür ederim bir iki hususu düzeltme ve ilave isteme imkanımız olursa süper olur
1- kanuni faiz başlama tarihini otomatik olarak bu günü alıyor onu manuel bir hücreye (B2 hücresi) girdiğim tarihi baz alarak yapabilirmiyiz her zaman içinde bulunduğumuz gün olmayabiliyor.
2- Yine taksit tarihini bir hücreye manuel yazsak (C2 hücresi) onu baz alarak devam etse ondada ödeme yapacak kişi taksit ödeme tarihini farklı isteyebilir
3- D, G ve H sütunlarında taksit bitti satırın altına toplama yaptırabilirmiyiz
4- A sütununa A5 ten başlayarak 1. Taksit, 2. Taksit şeklinde sıra numarası yazdırabilirmiyiz

 

[YUSUF44]

Ekli dosyayı inceleyiniz.

 

[yalovam77]

Merhaba üstadım çok teşekkür ederim süper olmuş ellerinize sağlık sadece H2 hücresine gün değilde tam tarih girsem ( örneğin 17.09.2021 gibi) ve ilk taksit tarihi onu alarak başlasa 1 er ay arttırarak mümkünmü

 

[YUSUF44]

#4 nolu mesajdaki dosyayı güncelledim. İnceleyiniz.

 

[yalovam77]

çok çok teşekkür ederim ellerinize sağlık

 

[yalovam77]

Üstadım tabloda 1. taksitin gün farkında ve faiz tutarında bir anormallik var sanki

 

[YUSUF44]

Nedenini çözemedim ama makro gün farkını çok alakasız bir sonuç buluyordu. Aşağıdaki gibi çözebildim:

Sub kredi()
Set s1 = Sheets("Sayfa1")
son = s1.Cells(Rows.Count, "B").End(3).Row
s1.Activate
Application.ScreenUpdating = False
    If son > 4 Then
        s1.Range("B5:H" & son).ClearContents
        Range("B5:H" & son - 1).Borders(xlEdgeBottom).LineStyle = xlNone
        Range("B5:H" & son).Font.Bold = False
    End If
    If s1.[C2] = "" Then
        MsgBox "Lütfen toplam borç tutarını giriniz!", vbExclamation
        [C2].Select
        Exit Sub
    ElseIf s1.[E2] = "" Then
        MsgBox "Lütfen toplam taksit sayısını giriniz!", vbExclamation
        [E2].Select
        Exit Sub
    ElseIf s1.[F2] = "" Then
        MsgBox "Lütfen borcun başlama tarihini giriniz!", vbExclamation
        [F2].Select
        Exit Sub
    ElseIf s1.[H2] = "" Then
        MsgBox "Lütfen ilk taksidin ödeme gününü giriniz!", vbExclamation
        [H2].Select
        Exit Sub
    ElseIf IsNumeric(s1.[C2]) = False Then
        MsgBox "Lütfen toplam borç tutarını sayısal olarak giriniz!", vbExclamation
        [C2].Select
        Exit Sub
    ElseIf [H2] <= [F2] Then
        MsgBox "Lütfen ilk taksit tarihini borç başlama tarihinden sonraki bir gün olarak seçiniz!", vbExclamation
        [H2].Select
        Exit Sub
    Else
        borc = [C2]
        taksitsay = [E2]
        taksit = Round(borc / taksitsay, 2)
        basla = [F2]
        odegun = Day([H2])
        [B5] = "1. Taksit"
        Range("C5:C" & taksitsay + 4) = basla
        Range("D5:D" & taksitsay + 4) = taksit
        [D5].ClearContents
        [E5] = [H2]
        [F5].Formula = "=E5-C5" ' [H2] - [F2]
        [G5] = [F5] * 9 * [D5] / 36000
        [H5] = [D5] + [G5]
        If taksitsay > 1 Then
            For i = 2 To taksitsay
                Cells(i + 4, "B") = i & ". Taksit"
                Cells(i + 4, "E") = DateSerial(Year(Cells(i + 3, "E")), Month(Cells(i + 3, "E")) + 1, odegun)
                Cells(i + 4, "F") = Cells(i + 4, "E") - Cells(i + 4, "C")
                Cells(i + 4, "G") = Cells(i + 4, "F") * 9 * Cells(i + 4, "D") / 36000
                Cells(i + 4, "H") = Cells(i + 4, "D") + Cells(i + 4, "G")
            Next
        End If
    End If
    enson = Cells(Rows.Count, "C").End(3).Row
    odenen = WorksheetFunction.Sum(Range("D5:D" & enson))
    [D5] = borc - odenen
    [G5] = [F5] * 9 * [D5] / 36000
    [H5] = [D5] + [G5]
    Range("C5:C" & enson + 1).NumberFormat = "dd/mm/yyyy"
    Range("E5:E" & enson + 1).NumberFormat = "dd/mm/yyyy"
    Range("D5:D" & enson + 1).NumberFormat = "#,##0.00"
    Range("B5:B" & enson).NumberFormat = "General"
    Range("G5:H" & enson + 1).NumberFormat = "#,##0.00"
    Range("B" & enson + 1 & ":H" & enson + 1).Font.Bold = True
    Range("B" & enson & ":H" & enson).Borders(xlEdgeBottom).LineStyle = 2
    Cells(enson + 1, "B") = "TOPLAM"
    Cells(enson + 1, "D") = WorksheetFunction.Sum(Range("D5:D" & enson))
    Cells(enson + 1, "G") = WorksheetFunction.Sum(Range("G5:G" & enson))
    Cells(enson + 1, "H") = WorksheetFunction.Sum(Range("H5:H" & enson))
Application.ScreenUpdating = True
MsgBox "işlem Tamamlandı", vbExclamation, "BİTTİ"
End Sub