• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücredeki değere göre hesaplama yapıp alta satır ekleme

A

aercin

Katılım
7 Haziran 2006
Mesajlar
47
Merhabalar,
Malum kredi kartları başa bela. Kartların taksitlerini takip edip ayağımızı yorganımıza göre uzatmak için bir excel yapayım dedim. Ama yapamadım :) Yardımlarınızı bekliyorum.

Taksit sayısı 1 den büyükse tutarı taksit adedine göre bölerek alta taksit adedi kadar satır ekleyip, ilk satırı silecek.
Şöyleki ;

A B C D E F G
Tarih Kart Kullanan Grup Tutar Taksit Sayısı Açıklama
10.05.2016 CardFinans Ayşe Giyim 100 ₺ 5


Taksit sayısını yazdıktan sonra 1 den büyükse alta satırlar otomatik eklenecek (tarih,, tutar ve taksit sayısı değişiyor) ve İlk satırı silecek
A B C D E F G
Tarih Kart Kullanan Grup Tutar Taksit Sayısı Açıklama
10.05.2016 CardFinans Ayşe Giyim 20 ₺ 1/5
10.06.2016 CardFinans Ayşe Giyim 20 ₺ 2/5
10.07.2016 CardFinans Ayşe Giyim 20 ₺ 3/5
10.08.2016 CardFinans Ayşe Giyim 20 ₺ 4/5
10.09.2016 CardFinans Ayşe Giyim 20 ₺ 5/5
 
Kodu yazdıktan sonra, her alanın farklı hücrede olduğunu farkettim.
Bilgi A1 hücresinde ve aşağı doğru varsayılmıştır.

Tek hücre istemiyorsanız düzenleyiniz : )

Bu bilgilerin sonucu,
10.05.2016 CardFinans Ayşe Giyim 20 ₺ 5
10.05.2016 CardFinans Ayşe Giyim 100 ₺
10.05.2016 CardFinans Ayşe Giyim 100 ₺ 1

Bu şekilde olmaktadır.
10.05.2016 CardFinans Ayşe Giyim 20 ₺ 1/5
10.06.2016 CardFinans Ayşe Giyim 20 ₺ 2/5
10.07.2016 CardFinans Ayşe Giyim 20 ₺ 3/5
10.08.2016 CardFinans Ayşe Giyim 20 ₺ 4/5
10.09.2016 CardFinans Ayşe Giyim 20 ₺ 5/5
10.05.2016 CardFinans Ayşe Giyim 100 ₺
10.05.2016 CardFinans Ayşe Giyim 100 ₺ 1


Kod: 
Sub Taksitle()
 sonsatir = Cells(Rows.Count, "A").End(3).Row
 For i = sonsatir To 1 Step -1
   bilgi = Cells(i, 1).Value
   parcaliste = Split(bilgi, " ")
   tarih = CDate(parcaliste(LBound(parcaliste)))
   kactaksit = Val(parcaliste(UBound(parcaliste)))
   metin = Mid(bilgi, Len(tarih) + 1, (Len(bilgi) - Len(tarih)) - Len(kactaksit))
   If kactaksit > 1 Then
     For j = kactaksit To 1 Step -1
       yenitarih = DateAdd("m", j - 1, tarih)
       yenimetin = yenitarih & metin & j & "/" & kactaksit
       If j <> kactaksit Then
           Cells(i, 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
       End If
       Cells(i, 1).Value = yenimetin
     Next j
   End If
 Next i
End Sub
 
Son düzenleme:
Bütün bilgileri A hücresine yazdığımda dediğiniz gibi çalıştı.
Hücrelere göre düzenleyebilir miyim pek ümitli olmasam da deneyeceğim.
Ama şöyle bir sorun var ki; ben makro çalıştırdığımda değil Taksit (F) sütunundaki değer değiştiğinde otomatik satırları çoğaltsın, "taksitler işlensin mi" diye sorsa daha da güzel tabi :)
 
aercin' Alıntı:
Bütün bilgileri A hücresine yazdığımda dediğiniz gibi çalıştı.
Hücrelere göre düzenleyebilir miyim pek ümitli olmasam da deneyeceğim.
Ama şöyle bir sorun var ki; ben makro çalıştırdığımda değil Taksit (F) sütunundaki değer değiştiğinde otomatik satırları çoğaltsın, "taksitler işlensin mi" diye sorsa daha da güzel tabi :)
Genişletmek için tıkla ...

Dosya.tc den örnek dosya payşırsanız yardımcı olacak arkadaşlar olacaktır.

F sütünu değiştiğinde diye yazmışsınız.

10.05.2016 CardFinans Ayşe Giyim 20 ₺ 1/5
10.06.2016 CardFinans Ayşe Giyim 20 ₺ 2/5

taksitlendirme yapılmış satırlarda bir değişiklik yapılmayacak sanırım.
Yeni bir satır eklendiğinde mi işlem yapılacak.

Yada kullanıcı taksitlendirmeyi silerek araya yeni bir satır ekleycek 5 taksit yerien 10 taksit gibi.
 
dosya linki:
http://s5.dosya.tc/server2/oyvi8g/kredikartitakip.xlsx.html

kendime göre kodları düzenledim. ama sadece son satıra göre işlem yapıyor.
Taksit sayısı sütununda 1 den büyük olana göre işlem yapmalı, gerekirse araya satır eklemeli. Bunları beceremedim...
Değiştirdiğim amatör kodlarım aşağıda...

Sub Taksithesapla()
sonsatir = Cells(Rows.Count, "A").End(3).Row
For i = sonsatir To 2 Step -1
ilktarih = Cells(i, 1).Value
kart = Cells(i, 2).Value
kullanici = Cells(i, 3).Value
grup = Cells(i, 4).Value
tutar = Cells(i, 5).Value
kactaksit = Cells(i, 6).Value
aciklama = Cells(i, 7).Value
If kactaksit > 1 Then
For j = kactaksit To 1 Step -1
yenitarih = DateAdd("m", j - 1, ilktarih)
If j <> kactaksit Then
Cells(i, 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 4).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 5).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 6).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 1).Value = yenitarih
Cells(i, 2).Value = kart
Cells(i, 3).Value = kullanici
Cells(i, 4).Value = grup
Cells(i, 5).Value = tutar / kactaksit
taksitbilgisi = j & "/" & kactaksit
Cells(i, 6).Value = taksitbilgisi
Cells(i, 7).Value = aciklama
End If
Next j
End If
Next i
ensonsatir = Cells(Rows.Count, "A").End(3).Row
Rows(ensonsatir).Delete
End Sub
 
Yukardaki linkteki dosyaya uygun olarak yapılan örnek dosya aşağıdaki mesajdaki linkte
 
Son düzenleme:
Aslında baştan öyle yapmıştım. Örnek dosyanıza göre değiştirdim. Taksit sayısı değiştirilince veriyi tekrar toparlamak zahmetli olacak ama bir deneyeyim. Userform'lu çözüm daha kolay olur ister misin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst