taksitlendirme ve otomatik artan ve eksilen sütun oluşturma.

poetika · 7 Kasım 2007

merhaba. ekte sunduğum dosyada üstteki hücredeki taksit sayısını girdiğim zaman taksitlendirme tablosundaki satırları o sayı kadar arttırıp eksiltmek istiyorum. mesela taksit kısmına 4 dedim. taksitlendirme tablosunu dört satırdan oluştursun ve altına yine "toplam" satırını eklesin. taksit kısmına 2 yazdığımda tabloyu iki satıra dönüştürsün. bu mümkün mü acaba? nasıl yapabilirim. yardımlarınız için şimdiden teşekkürler.

Ferhat Pazarçevirdi · 7 Kasım 2007

Merhabalar

Aşağıdakileri Sayfa1 adlı sheet'in kod sayfasına kopyalayınız veya örnek dosyayı inceleyiniz.

Kod:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
If Target.Address = Cells(2, "B").Address Then
   If Target > 0 Then
      With Range("A5:D" & Cells(65536, 1).End(xlUp).Row)
           .ClearContents
           .Borders(xlDiagonalDown).LineStyle = xlNone
           .Borders(xlDiagonalUp).LineStyle = xlNone
           .Borders(xlEdgeLeft).LineStyle = xlNone
           .Borders(xlEdgeTop).LineStyle = xlNone
           .Borders(xlEdgeBottom).LineStyle = xlNone
           .Borders(xlEdgeRight).LineStyle = xlNone
           .Borders(xlInsideVertical).LineStyle = xlNone
           .Borders(xlInsideHorizontal).LineStyle = xlNone
      End With
      
      For i = 5 To Target + 4
          Cells(i, 1) = i - 4
      Next i
      Cells(i, 1) = "TOPLAM"
      Cells(i, 2).Formula = "=SUM(B5:B" & i - 1 & ")"
      Cells(i, 3).Formula = "=SUM(C5:C" & i - 1 & ")"
      Cells(i, 4).Formula = "=SUM(D5:D" & i - 1 & ")"
      
      With Range("A5:D" & Cells(65536, 1).End(xlUp).Row)
          .Borders(xlDiagonalDown).LineStyle = xlNone
          .Borders(xlDiagonalUp).LineStyle = xlNone
          .Borders(xlEdgeLeft).LineStyle = xlContinuous
          .Borders(xlEdgeTop).LineStyle = xlContinuous
          .Borders(xlEdgeBottom).LineStyle = xlContinuous
          .Borders(xlEdgeRight).LineStyle = xlContinuous
          .Borders(xlInsideVertical).LineStyle = xlContinuous
          .Borders(xlInsideHorizontal).LineStyle = xlContinuous
      End With
   End If
End If
End Sub

poetika · 15 Kasım 2007

öncelikle yardımlarınız için teşekkürler. ben bu kodu farklı bir dosyada kullanmayı denedim bi iki değişiklik yaparak tabi beceremedim. acaba ekte yolladığım dosyaya uygun olarak verdiğiniz kodda nasıl bi değişiklik yapmam gerekir. yardım ederseniz çok memnun olurum. şimdiden teşekkürler. saygılar.

Ferhat Pazarçevirdi · 15 Kasım 2007

Kodları aşağıdaki gibi revize ediniz. (veya örnek dosyayı inceleyiniz)

Kod:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Integer
On Error GoTo f1
If IsNumeric(Target) = False Then: Exit Sub
Application.EnableEvents = False
If Target.Address = Cells(1, "B").Address Then
   If Target > 0 Then
      With Range("A5:L" & Cells(65536, 1).End(xlUp).Row)
           .ClearContents
           .Borders(xlDiagonalDown).LineStyle = xlNone
           .Borders(xlDiagonalUp).LineStyle = xlNone
           .Borders(xlEdgeLeft).LineStyle = xlNone
           .Borders(xlEdgeTop).LineStyle = xlNone
           .Borders(xlEdgeBottom).LineStyle = xlNone
           .Borders(xlEdgeRight).LineStyle = xlNone
           .Borders(xlInsideVertical).LineStyle = xlNone
           .Borders(xlInsideHorizontal).LineStyle = xlNone
      End With
      For i = 5 To Target + 4
          Cells(i, 1) = i - 4
          Cells(i, 4).Formula = "=B2/B1"
          Cells(i, 8).Formula = "=B" & i & "-C" & i
          Cells(i, 10).Formula = "=E" & i & "*F" & i & "*G" & i & "/36500"
          Cells(i, 11).Formula = "=E" & i & "*F" & i & "*H" & i & "/36500"
          If i = 5 Then
             Cells(i, 5).Formula = "=B2"
             Cells(i, 7).Formula = "=IF(B" & i & "=0,0,B5-B3)"
          Else
             Cells(i, 5).Formula = "=E" & i - 1 & "-D" & i - 1
             Cells(i, 7).Formula = "=IF(B" & i & "=0,0,B" & i & "-B" & i - 1 & ")"
          End If
      Next i
      
      Cells(i, 1) = "TOPLAM"
      Cells(i, "D").Formula = "=SUM(D5:D" & i - 1 & ")"
      Cells(i, "I").Formula = "=SUM(I5:I" & i - 1 & ")"
      Cells(i, "J").Formula = "=SUM(J5:J" & i - 1 & ")"
      Cells(i, "K").Formula = "=SUM(K5:K" & i - 1 & ")"
      Cells(i, "L").Formula = "=I" & i & "+J" & i & "+D" & i
      For j = 5 To Target + 4: Cells(j, 12).Formula = "=L" & i & "/B1": Next
      
      
      With Range("A5:L" & Cells(65536, 1).End(xlUp).Row)
          .Font.ColorIndex = 55
          .Font.Bold = True
          .Borders(xlDiagonalDown).LineStyle = xlNone
          .Borders(xlDiagonalUp).LineStyle = xlNone
          .Borders(xlEdgeLeft).LineStyle = xlContinuous
          .Borders(xlEdgeTop).LineStyle = xlContinuous
          .Borders(xlEdgeBottom).LineStyle = xlContinuous
          .Borders(xlEdgeRight).LineStyle = xlContinuous
          .Borders(xlInsideVertical).LineStyle = xlContinuous
          .Borders(xlInsideHorizontal).LineStyle = xlContinuous
      End With
      Range("A5:C" & Cells(65536, 1).End(xlUp).Row - 1).HorizontalAlignment = xlCenter
      Range("F5:H" & Cells(65536, 1).End(xlUp).Row - 1).HorizontalAlignment = xlCenter
      
      With Range("D5:E" & Cells(65536, 1).End(xlUp).Row)
          .NumberFormat = "#,##0.00"
          .HorizontalAlignment = xlRight
      End With
      With Range("I5:L" & Cells(65536, 1).End(xlUp).Row + 1)
          .NumberFormat = "#,##0.00"
          .HorizontalAlignment = xlRight
      End With
      Range("A" & i & ":L" & i).Font.ColorIndex = 0
   End If
Application.EnableEvents = True
End If
Exit Sub
f1: Application.EnableEvents = True
End Sub

poetika · 15 Kasım 2007

tekrar merhaba sayın fpc. yardımcı oluyosunuz çok teşekkür ederim. fakat şöyle bir sorunum var. ekte yolladığınız dosyayı açtıktan sonra herhangi bir veri girmediğim takdirde kod çalışıyo. fakat tarih kısımlarına yada faiz oranı kısmına veri girdiğimde kod çalışmıyo. acaba ben mi yanlış bişey yapıyorum onu da bilmiyorum. tekrar teşekkür ederim.saygılar.

Ferhat Pazarçevirdi · 15 Kasım 2007

Ama sadece taksit sayısı değilmidir ki tablonun boyutunu belirleyen ?...

Taksit sayısını girdiğinizde tablo hem yeni formülleri hem de yeni yapısına kavuşuyor?

Örneğin, 10 taksit yerine 15 taksit yaparsanız tablo ona göre şekillenir. Ana parayı ve diğerlerini girdiğinizde formüller otomatikman hesaplamaları yapar?

Kısacası ne demek istediğinizi tam olarak anlayamadım

poetika · 16 Kasım 2007

anlatmaya çalıştığım şey şuydu:şimdi tablo da benim veri gireceğim değerler boş. bunlar tarih aralıkları ve faiz oranı.veriler boşken taksit tutarında hangi değişikliği yaparsam yapayım satırlarda eksilme ya da azalma oluyor. yani bir problem yok. ama işim gereği diyelimki müşteri geldi. taksit miktarını kararlaştırdık. taksit miktarını girdim ve satırlar buna göre güncellendi. vadeleri girdim. faiz oranını girdim. daha sonra taksit tutarında müşteri karar değiştirdi. aynı çalışma üzerinde tekrardan taksit değerini değiştirdiğim zaman bu kez kod çalışmıyo. taksidi 7 olarak belirleyip diğer verileri girdikten sonra herhangi bir karar değişikliği olursa örneğin taksidi 5 e düşürünce satırlar eksilmiyo aynı kalıyo. dosyayı kapatıp tekrar açmam lazım yani.

Ferhat Pazarçevirdi · 16 Kasım 2007

Anlaşıldı. O zaman şu kodları deneyiniz.

Kod:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, j As Integer
On Error GoTo f1
If IsNumeric(Target) = False Then: Exit Sub
If Target.Address = Cells(1, "B").Address Then
   Application.EnableEvents = False
   If Target > 0 Then
      With Range("A5:L" & Cells(65536, 1).End(xlUp).Row)
           .ClearContents
           .Borders(xlDiagonalDown).LineStyle = xlNone
           .Borders(xlDiagonalUp).LineStyle = xlNone
           .Borders(xlEdgeLeft).LineStyle = xlNone
           .Borders(xlEdgeTop).LineStyle = xlNone
           .Borders(xlEdgeBottom).LineStyle = xlNone
           .Borders(xlEdgeRight).LineStyle = xlNone
           .Borders(xlInsideVertical).LineStyle = xlNone
           .Borders(xlInsideHorizontal).LineStyle = xlNone
      End With
      For i = 5 To Target + 4
          Cells(i, 1) = i - 4
          Cells(i, 4).Formula = "=B2/B1"
          Cells(i, 8).Formula = "=B" & i & "-C" & i
          Cells(i, 10).Formula = "=E" & i & "*F" & i & "*G" & i & "/36500"
          Cells(i, 11).Formula = "=E" & i & "*F" & i & "*H" & i & "/36500"
          If i = 5 Then
             Cells(i, 5).Formula = "=B2"
             Cells(i, 7).Formula = "=IF(B" & i & "=0,0,B5-B3)"
          Else
             Cells(i, 5).Formula = "=E" & i - 1 & "-D" & i - 1
             Cells(i, 7).Formula = "=IF(B" & i & "=0,0,B" & i & "-B" & i - 1 & ")"
          End If
      Next i
      
      Cells(i, 1) = "TOPLAM"
      Cells(i, "D").Formula = "=SUM(D5:D" & i - 1 & ")"
      Cells(i, "I").Formula = "=SUM(I5:I" & i - 1 & ")"
      Cells(i, "J").Formula = "=SUM(J5:J" & i - 1 & ")"
      Cells(i, "K").Formula = "=SUM(K5:K" & i - 1 & ")"
      Cells(i, "L").Formula = "=I" & i & "+J" & i & "+D" & i
      For j = 5 To Target + 4: Cells(j, 12).Formula = "=L" & i & "/B1": Next
      
      
      With Range("A5:L" & Cells(65536, 1).End(xlUp).Row)
          .Font.ColorIndex = 55
          .Font.Bold = True
          .Borders(xlDiagonalDown).LineStyle = xlNone
          .Borders(xlDiagonalUp).LineStyle = xlNone
          .Borders(xlEdgeLeft).LineStyle = xlContinuous
          .Borders(xlEdgeTop).LineStyle = xlContinuous
          .Borders(xlEdgeBottom).LineStyle = xlContinuous
          .Borders(xlEdgeRight).LineStyle = xlContinuous
          .Borders(xlInsideVertical).LineStyle = xlContinuous
          .Borders(xlInsideHorizontal).LineStyle = xlContinuous
      End With
      Range("A5:C" & Cells(65536, 1).End(xlUp).Row - 1).HorizontalAlignment = xlCenter
      Range("F5:H" & Cells(65536, 1).End(xlUp).Row - 1).HorizontalAlignment = xlCenter
      
      With Range("D5:E" & Cells(65536, 1).End(xlUp).Row)
          .NumberFormat = "#,##0.00"
          .HorizontalAlignment = xlRight
      End With
      With Range("I5:L" & Cells(65536, 1).End(xlUp).Row + 1)
          .NumberFormat = "#,##0.00"
          .HorizontalAlignment = xlRight
      End With
      Range("A" & i & ":L" & i).Font.ColorIndex = 0
   End If
Application.EnableEvents = True
End If
Exit Sub
f1: Application.EnableEvents = True
End Sub

poetika · 16 Kasım 2007

sayın fpc çok teşekkür ederim verdiğiniz kod için. dosyayı revize ettim ve bir dosyayla daha bağlantı oluşturdum. ekte sunuyorum. birtek problem kaldı. tarihlerin bulunduğu hücrelerin içindeki değerlerin ikinci bir taksit miktarı değeri girilişinde silinmesi. bununla ilgili bir çözüm bulunabilir mi? saygılar.

poetika · 16 Kasım 2007

dosyayı yollamayı unutmuşum. ekte sunuyorum.

kutlay_islek · 5 Ocak 2019

Merhaba; Benimde buna benzer bir sorunum var, örneğin a sütununda vade sayısı yazıyor. B sütununa otomatik olarak artan tarihleri nasıl getirebilirim.
Yani a1 sütunundaki vade sayısı yani 9 taksit azalarak 0'a kadar düşmeli, B sütunundaki tarihte vade sayısına göre otomatik olarak her ayın aynı günü olarak artmalı. Günlerdir uğraşıyorum başaramadım. Bununla ilgili makro değil formül işimi görüyor bu arada. Eğer varsa formülü yardımcı olabilirseniz mutlu olurum. Syg.

taksitlendirme ve otomatik artan ve eksilen sütun oluşturma.

poetika

Ferhat Pazarçevirdi

Özel Üye

poetika

Ferhat Pazarçevirdi

Özel Üye

poetika

Ferhat Pazarçevirdi

Özel Üye

poetika

Ferhat Pazarçevirdi

Özel Üye

poetika

poetika

kutlay_islek