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

P

poetika

Altın Üye
Katılım
6 Kasım 2005
Mesajlar
133
Excel Vers. ve Dili
Excel 2010 Türkçe
Altın Üyelik Bitiş Tarihi
30-09-2027
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.
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
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
 
P

poetika

Altın Üye
Katılım
6 Kasım 2005
Mesajlar
133
Excel Vers. ve Dili
Excel 2010 Türkçe
Altın Üyelik Bitiş Tarihi
30-09-2027
ö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.
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
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
 
P

poetika

Altın Üye
Katılım
6 Kasım 2005
Mesajlar
133
Excel Vers. ve Dili
Excel 2010 Türkçe
Altın Üyelik Bitiş Tarihi
30-09-2027
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.
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
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
 
P

poetika

Altın Üye
Katılım
6 Kasım 2005
Mesajlar
133
Excel Vers. ve Dili
Excel 2010 Türkçe
Altın Üyelik Bitiş Tarihi
30-09-2027
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.
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
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
 
P

poetika

Altın Üye
Katılım
6 Kasım 2005
Mesajlar
133
Excel Vers. ve Dili
Excel 2010 Türkçe
Altın Üyelik Bitiş Tarihi
30-09-2027
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.
 
P

poetika

Altın Üye
Katılım
6 Kasım 2005
Mesajlar
133
Excel Vers. ve Dili
Excel 2010 Türkçe
Altın Üyelik Bitiş Tarihi
30-09-2027
dosyayı yollamayı unutmuşum. ekte sunuyorum.
 
K

kutlay_islek

Katılım
17 Nisan 2012
Mesajlar
7
Excel Vers. ve Dili
Microsoft Office 2010 Professional / İngilizce
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.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst