Taksit Yazdirma

[ziya]

Ben mesajınızı okumadan düzeltme yaptım, siz bu arada haklı olarak müdahale etmişsiniz. Ben de sizin yaptığınızı yapardım. İşin kötü yanı FERHATTURAN üstüne alınmış veya beni korumaya çalışmış, hatayı yapan benim.
Özür dilerim.

 

[Necdet]

Birden Fazla Taksitlendirme

biraz ugrastım ama beceremedim
bu taksitlendirme birden fazla olsa ama geçerli aya o aya ait taksit tutarı eklenmesi mumkunmu

şimdiden tesekkurler

Merhaba,

Biraz gecikmeli yanıt oldu ama, idare edin artık. Fonksiyonlarla nasıl yapılır bilemem ama makroyla çözmeye çalıştım ve ilk aklıma gelen çözümü uyguladım.

Ekteki dosyayı inceliyiniz.

Public Sub Hesapla()
Application.ScreenUpdating = False
[F2:J5000].ClearContents
For i = 2 To [A65536].End(3).Row
    TaksitSayısı = Cells(i, "B")
    Satır = [G65536].End(3).Row + 1
    Adet = 1
    TaksitTutarı = Round(Cells(i, "A") / TaksitSayısı, 1)
    EkTaksit = Round(Cells(i, "A") - TaksitTutarı * TaksitSayısı,1)
    Tarih = DateSerial(Year(Cells(i, "C")), Month(Cells(i, "C")), Day(Cells(i, "C")))
    Do
        Cells(Satır, "G") = Tarih
        Cells(Satır, "H") = TaksitTutarı
        If Adet = 1 Then Cells(Satır, "H") = Cells(Satır, "H") + EkTaksit
        Cells(Satır, "J") = Cells(i, "D")
        Satır = Satır + 1
        Adet = Adet + 1
        Tarih = DateSerial(Year(Tarih), Month(Tarih) + 1, Day(Tarih))
    Loop While Adet <= Cells(i, "B")
Next i
'--------- Hesaplama Bitti Sıralama Yapılıyor ---------
i = [G65536].End(3).Row
Range("G2:J" & i).Sort key1:=[G2], Key2:=[J2]
'------- Ödeme tarihleri eşit olan satırlar tek satırda birleştiriliyor ----
For i = [G65536].End(3).Row To 3 Step -1
    If Month(Cells(i - 1, "G")) = Month(Cells(i, "G")) Then
        Cells(i - 1, "H") = Cells(i - 1, "H") + Cells(i, "H")
        Cells(i - 1, "J") = Cells(i - 1, "J") & " - " & Cells(i, "J")
        Range("G" & i & ":J" & i).Delete Shift:=xlUp
    End If
Next i
'--- Sıra Numarası ve Toplam Ödemeler Hesaplanıyor
For i = 2 To [G65536].End(3).Row
    Cells(i, "F") = i - 1
    If i = 2 Then
        Cells(i, "I") = Cells(i, "H")
    Else
        Cells(i, "I") = Cells(i - 1, "I") + Cells(i, "H")
    End If
Next i
End Sub

 

[FERHATTURAN]

necdet ustam ismin zor olsada sen bi tanesin walla ellerine saglık cok mukemmel iş cıkardınız ben bile bukadar hayal etmemiştim cok tesekkurler

 

[Necdet]

Güle güle kullanınız, az taksitli, olası ise taksitsiz günler dilerim