Soru Gider Takip Çalışmasında Taksitli İşlemleri İlgili Sayfalara Yazdırma?

[s.savas]

Merhaba arkadaşlar.
Basitçe bir arayüzle kişisel gider takip formu hazırladım.
Yaptığım aylık harcamalar ile birlikte bütçe takibini yapıyorum. Taksitli yapılan harcamaları da forma manuel olarak giriş yapıyorum.
İstiyorum ki yeni kayıt işleminde yapılan işlem taksitli ise ilk taksit (ilgili aya kayıt ediliyor) devam eden taksitli işlemleri de takip eden aylara otomatik olarak kayıt edilsin.
Algoritma şu şekilde olmalı diye düşünüyorum;
Yeni kayıt işleminde, işlem taksitli (textbox3 dolu ise) ise;
ilk taksit işlem yapılan ay'a işlenecek (yapılıyor)
kalan taksitler takip eden ay'lara işlenecek
kayıt yapılacak ay (sekme adı) yok ise; şablon isimli sekmeden
eksik aylar oluşturularak kayıt işlemine devam edecek.

Kayıt işlemi için gerekli olan kod düzenlemesine yardımcı olacak arkadaşlara teşekkür ederim.

 

[Asri]

Direkt kod yerine yardımcı olmaya çalışayım.
Aşağıda iki fonksiyon yazdım.
1. fonksiyon ay ismini sayısal olarak verecek.
2. fonksiyonda bu ay bilgisini bir arttırarak sonraki ay için sayfa adı oluşturacak.
Bu şekilde kaç taksit var ise sonraki ayları kolay bir şekilde bulabilirsiniz.
Sonraki ay bulma işleminde sonraki yıllar da dahildir.

Öncelikle taksit durumlarında sonraki aylarda kayıt düzeltme yapabilmeniz için tüm aylarda referans kodu kullanmanız gerekir.
Bu kod sadece o kayıt için olmalı başka bir kayıtta kullanılmamalı.

Örnek: EKİM 2020 de 4 taksitlik bir işlem yapıldı.
EKİM sayfasına bilgileri yazdınız referans koduda REF000001 olsun.
3 taksit kaldı. KASIM 2020 yi bu fonksiyon ile belirlediniz. buna da kayıt yaparken REF000001 olarak kayıt yaptınız.
diğer ayları bu şekilde kayıt yaptınız.

Düzeltme işlemi yaparken de bu sayfalarda bu referans kodunu bulup bunları düzelteceksiniz.

Belki farklı şekilde yorumlar gelebilir. Bende görmek isterim.

Saygılarımla.


Kullanımı:
aybilgisi = Left(ActiveSheet.Name, InStr(ActiveSheet.Name, " ") - 1)
yilbilgisi = Mid(ActiveSheet.Name, InStr(ActiveSheet.Name, " ") + 1, Len(ActiveSheet.Name))

ay = hangiay(aybilgisi)
yenitaksitayi = yenitaksitayibul(hangiay(aybilgisi), yilbilgisi)

Function hangiay(aystr) As Integer
    Select Case aystr
        Case "OCAK": hangiay = 1
        Case "ŞUBAT": hangiay = 2
        Case "MART": hangiay = 3
        Case "NİSAN": hangiay = 4
        Case "MAYIS": hangiay = 5
        Case "HAZİRAN": hangiay = 6
        Case "TEMMUZ": hangiay = 7
        Case "AĞUSTOS": hangiay = 8
        Case "EYLÜL": hangiay = 9
        Case "EKİM": hangiay = 10
        Case "KASIM": hangiay = 11
        Case "ARALIK": hangiay = 12
        Case Else: hangiay = 0
    End Select
End Function

Function yenitaksitayibul(ayint, yilint) As String
   If ayint + 1 > 12 Then
     yeniay = 1
     yeniyil = yilint + 1
   Else
     yeniay = ayint + 1
     yeniyil = yilint
   End If
   
    Select Case yeniay
        Case 1: aystr = "OCAK"
        Case 2: aystr = "ŞUBAT"
        Case 3: aystr = "MART"
        Case 4: aystr = "NİSAN"
        Case 5: aystr = "MAYIS"
        Case 6: aystr = "HAZİRAN"
        Case 7: aystr = "TEMMUZ"
        Case 8: aystr = "AĞUSTOS"
        Case 9: aystr = "EYLÜL"
        Case 10: aystr = "EKİM"
        Case 11: aystr = "KASIM"
        Case 12: aystr = "ARALIK"
        Case Else: aystr = 0
    End Select
   
    yenitaksitayibul = aystr & " " & yeniyil
   
End Function

 

[Tevfik_Kursun]

Merhaba Asri Hocam,
KTF ler nasıl çalışıyor?
Saygılarımla

 

[Asri]

Merhaba Asri Hocam,
KTF ler nasıl çalışıyor?
Saygılarımla

Hocam, sayfa isimleri ay ve yıl olarak yazılmış "EKİM 2020" ve kayıt sırasında ilgili sayfa aktif sayfaya yapılıyor.

aybilgisi = "EKİM" ve yilbilgisi=2020 olacak şekilde, burada aktif sayfa adı parçalanıyor.
aybilgisi = Left(ActiveSheet.Name, InStr(ActiveSheet.Name, " ") - 1)
yilbilgisi = Mid(ActiveSheet.Name, InStr(ActiveSheet.Name, " ") + 1, Len(ActiveSheet.Name))

Bu işlemler "EKİM" sayısal olarak kaçıncı ay tespit ediliyor.
ay = hangiay(aybilgisi)

Burada 10, 2020 10. ay ve yıl 2020 bilgisi KTF ye veriliyor. Bunu bir ay arttır deniyor.
yenitaksitayi = yenitaksitayibul(hangiay(aybilgisi), yilbilgisi)

KTF "ay +1" 12 den büyük ise sonraki yıldır diyor ve yeni takist ayını 1. ay yılını verilen yıl +1 yapıyor.
1.2021 ve ayı yazıya çeviriyor. OCAK 2021 gibi.

Ay +1 12 den küçük ve eşit ise KTF ye verilen yıl sabit kalıyor ay bir arttırılarak yazıya çevrilip yazılıyor.

KASIM 2020 gibi.


KTF lerde hata kontrolü yok ancak kontrol için uygun veri yok ise 0 değeri dönüyor. Buradan kontrol edilebilir.

0 verilen yil (02020) yada ay için 0 gibi.

 

[s.savas]

Direkt kod yerine yardımcı olmaya çalışayım.
Aşağıda iki fonksiyon yazdım.
1. fonksiyon ay ismini sayısal olarak verecek.
2. fonksiyonda bu ay bilgisini bir arttırarak sonraki ay için sayfa adı oluşturacak.
Bu şekilde kaç taksit var ise sonraki ayları kolay bir şekilde bulabilirsiniz.
Sonraki ay bulma işleminde sonraki yıllar da dahildir.

Öncelikle taksit durumlarında sonraki aylarda kayıt düzeltme yapabilmeniz için tüm aylarda referans kodu kullanmanız gerekir.
Bu kod sadece o kayıt için olmalı başka bir kayıtta kullanılmamalı.

Örnek: EKİM 2020 de 4 taksitlik bir işlem yapıldı.
EKİM sayfasına bilgileri yazdınız referans koduda REF000001 olsun.
3 taksit kaldı. KASIM 2020 yi bu fonksiyon ile belirlediniz. buna da kayıt yaparken REF000001 olarak kayıt yaptınız.
diğer ayları bu şekilde kayıt yaptınız.

Düzeltme işlemi yaparken de bu sayfalarda bu referans kodunu bulup bunları düzelteceksiniz.

Belki farklı şekilde yorumlar gelebilir. Bende görmek isterim.

Saygılarımla.


Kullanımı:
aybilgisi = Left(ActiveSheet.Name, InStr(ActiveSheet.Name, " ") - 1)
yilbilgisi = Mid(ActiveSheet.Name, InStr(ActiveSheet.Name, " ") + 1, Len(ActiveSheet.Name))

ay = hangiay(aybilgisi)
yenitaksitayi = yenitaksitayibul(hangiay(aybilgisi), yilbilgisi)

Function hangiay(aystr) As Integer
    Select Case aystr
        Case "OCAK": hangiay = 1
        Case "ŞUBAT": hangiay = 2
        Case "MART": hangiay = 3
        Case "NİSAN": hangiay = 4
        Case "MAYIS": hangiay = 5
        Case "HAZİRAN": hangiay = 6
        Case "TEMMUZ": hangiay = 7
        Case "AĞUSTOS": hangiay = 8
        Case "EYLÜL": hangiay = 9
        Case "EKİM": hangiay = 10
        Case "KASIM": hangiay = 11
        Case "ARALIK": hangiay = 12
        Case Else: hangiay = 0
    End Select
End Function

Function yenitaksitayibul(ayint, yilint) As String
   If ayint + 1 > 12 Then
     yeniay = 1
     yeniyil = yilint + 1
   Else
     yeniay = ayint + 1
     yeniyil = yilint
   End If
  
    Select Case yeniay
        Case 1: aystr = "OCAK"
        Case 2: aystr = "ŞUBAT"
        Case 3: aystr = "MART"
        Case 4: aystr = "NİSAN"
        Case 5: aystr = "MAYIS"
        Case 6: aystr = "HAZİRAN"
        Case 7: aystr = "TEMMUZ"
        Case 8: aystr = "AĞUSTOS"
        Case 9: aystr = "EYLÜL"
        Case 10: aystr = "EKİM"
        Case 11: aystr = "KASIM"
        Case 12: aystr = "ARALIK"
        Case Else: aystr = 0
    End Select
  
    yenitaksitayibul = aystr & " " & yeniyil
  
End Function

Asri hocam saygılar bizden olsun, elinize emeğinize sağlık.
Kaydet makrosunu komple revize etmek gerekli. Biz basit işlemleri yapmakta bile zorlanırken sizin ufkunuza erişmek sanırım bize bir kaç gömlek büyük geliyor. Burada ktf yi nasıl kullanırız bilemedim.

Private Sub cmdKAYDET_Click()
Sheets(ComboBox5.Text).Select
On Error Resume Next
If Not FrameTest Then Exit Sub
Dim Say As Long, son As Long, Satır As Long
Dim sor

If OptionButton3.Value = True Then 'Yeni Kayıt

If TextBox1.Text = "" Then
TextBox1.SetFocus
MsgBox ("Lütfen İşlem Tarihini Giriniz..."), vbInformation, "..."
Exit Sub
End If

If TextBox3.Value = True Then
If TextBox4.Text = "" Then
TextBox4.SetFocus
MsgBox ("Lütfen Ödenen Taksit Sayısını Giriniz..."), vbInformation, "..."
Exit Sub
End If
End If

son = Cells(Rows.Count, "b").End(xlUp).Row + 1
TextBox7.Value = son - 1
Cells(son, "B").Value = CDate(TextBox1.Value) 'tarih
Cells(son, "B").HorizontalAlignment = xlCenter
Cells(son, "B").NumberFormat = "mm.dd.yyyy"
Cells(son, "C").Value = ComboBox1.Value 'kategori
Cells(son, "C").HorizontalAlignment = xlLeft
Cells(son, "D").Value = ComboBox2.Value 'alt kategori
Cells(son, "D").HorizontalAlignment = xlLeft
Cells(son, "E").Value = ComboBox3.Value 'harcama türü
Cells(son, "E").HorizontalAlignment = xlLeft
Cells(son, "F").Value = ComboBox4.Value 'harcama kalemi
Cells(son, "F").HorizontalAlignment = xlLeft
Cells(son, "G").Value = CCur(TextBox8.Value) 'taksit tutarı
Cells(son, "G").HorizontalAlignment = xlRight
Cells(son, "H").Value = TextBox3.Value 'taksit sayısı
Cells(son, "H").HorizontalAlignment = xlCenter
Cells(son, "I").Value = TextBox4.Value 'ödenen taksit
Cells(son, "I").HorizontalAlignment = xlCenter
Cells(son, "J").Value = TextBox5.Value 'kalan taksit
Cells(son, "J").HorizontalAlignment = xlCenter
Cells(son, "K").Value = CCur(TextBox6.Value) 'kalan tutar
Cells(son, "K").HorizontalAlignment = xlRight

MsgBox "" & TextBox1.Value & " Tarihli " & ComboBox2.Value & " Giderine Ait Yeni Kayıt Başarıyla Yapılmıştır. İyi Çalışmalar Dilerim", vbInformation, "Sn.  " & Application.username
cmdTEMİZLE_Click

'-------Sıra Numarası ver ve Tarihe Göre Sırala---------------------
Range("A2:K" & Cells(Rows.Count, 3).End(xlUp).Row).Sort Key1:=Range("B2"), Order1:=xlAscending
'-----------------------------------
Satır = Range("b65536").End(3).Row
If Satır = 2 Then
Cells(2, 1) = 1
ElseIf Satır > 2 Then
Cells(2, 1) = 1
Range("A2:A" & Satır).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
End If
'MsgBox " Sıralandı  ", vbInformation, "Sn.  " & Application.username
'--------------------------------------------------------------------
Unload UserForm1
UserForm1.Show

TextBox7.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
End If

If OptionButton4.Value = True Then 'Düzelt
If TextBox1.Text = "" Then
MsgBox "Lütfen İşlem Tarihini Giriniz...", , "Kayıt Hatası!!!"
Exit Sub
End If

Y = ListView1.SelectedItem.Index
SN = ListView1.ListItems(Y)

With Sheets(ComboBox5.Text)
.Cells(SN, 2).Value = CDate(TextBox1.Value) 'tarih
.Cells(SN, 2).HorizontalAlignment = xlCenter
.Cells(SN, 3).Value = ComboBox1.Value 'kategori
.Cells(SN, 3).HorizontalAlignment = xlLeft
.Cells(SN, 4).Value = ComboBox2.Value 'alt kategori
.Cells(SN, 4).HorizontalAlignment = xlLeft
.Cells(SN, 5).Value = ComboBox3.Value 'harcama türü
.Cells(SN, 5).HorizontalAlignment = xlLeft
.Cells(SN, 6).Value = ComboBox4.Value 'harcama kalemi
.Cells(SN, 6).HorizontalAlignment = xlLeft
.Cells(SN, 7).Value = CCur(TextBox8.Value) 'taksit tutarı
.Cells(SN, 7).HorizontalAlignment = xlRight
.Cells(SN, 8).Value = TextBox3.Value 'taksit sayısı
.Cells(SN, 8).HorizontalAlignment = xlCenter
.Cells(SN, 9).Value = TextBox4.Value 'ödenen taksit
.Cells(SN, 9).HorizontalAlignment = xlCenter
.Cells(SN, 10).Value = TextBox5.Value 'kalan taksit
.Cells(SN, 10).HorizontalAlignment = xlCenter
.Cells(SN, 11).Value = CCur(TextBox6.Value) 'kalan borç
.Cells(SN, 11).HorizontalAlignment = xlRight
End With

Set sht = Nothing

MsgBox "" & TextBox1.Value & " Tarihli " & ComboBox2.Value & " Giderine Ait Yeni Kayıt Başarıyla Güncellenmişti. İyi Çalışmalar Dilerim", vbInformation, "Sn.  " & Application.username

cmdTEMİZLE_Click
 Range("A2:K" & Cells(Rows.Count, 3).End(xlUp).Row).Sort Key1:=Range("B2"), Order1:=xlAscending
'---------------------------------------
Satır = Range("b65536").End(3).Row
If Satır = 2 Then
Cells(2, 1) = 1
ElseIf Satır > 2 Then
Cells(2, 1) = 1
Range("A2:A" & Satır).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
End If
'MsgBox " Sıralandı  ", vbInformation, "Sn.  " & Application.username

Unload UserForm1
UserForm1.Show
TextBox7.Value = WorksheetFunction.Count(Range("A1:A65500")) + 1
End If

If OptionButton5.Value = True Then 'Silme İşlemi
If TextBox1.Text = "" Then
MsgBox "İşlem Tarihini Giriniz...", , "Kayıt Hatası!!!"
Exit Sub
End If

If MsgBox(" " & TextBox1.Value & " Tarihine ait " & ComboBox2.Value & " Gider Kaydı Silinecektir. BUNU BİR DAHA DÜŞÜNÜN !!", vbInformation + vbYesNo, "..::DİKKAT::..") = vbNo Then Exit Sub
Y = ListView1.SelectedItem.Index
sat = ListView1.ListItems(Y)
x = ListView1.ListItems(Y).ListSubItems(4).Text
cevap = MsgBox("Silmek istediğinizden emin misiniz?", vbYesNo, "SİLME ONAYI")
If cevap = vbYes Then


With Sheets(ComboBox5.Text)
.Range("A" & sat & ":K" & sat).ClearContents
'.Rows(sat).ClearContents
End With


Set sh = Nothing

MsgBox " " & TextBox1.Value & " tarihli kayda ait Tüm Bilgiler Silinmiştir.", vbInformation

End If

cmdTEMİZLE_Click
Range("A2:K" & Cells(Rows.Count, 3).End(xlUp).Row).Sort Key1:=Range("B2"), Order1:=xlAscending

Satır = Range("b65536").End(3).Row
If Satır = 2 Then
Cells(2, 1) = 1
ElseIf Satır > 2 Then
Cells(2, 1) = 1
Range("A2:A" & Satır).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
End If
'MsgBox " Sıralandı  ", vbInformation, "Sn.  " & Application.username


Unload UserForm1
UserForm1.Show
End If

End Sub

 

[Asri]

Burada ktf yi nasıl kullanırız bilemedim.

Öncelikle programınızı referans (ID) numarasına göre yeniden düzenleyin.
Tüm aylarda ID kolonu olsun. Bu numara sadece o kayda özel olmalı. aynı ayda yada farklı bir ayda bu ID ile kayıt yapılmamış olmalı.
Her kayıtta artan bir numara olabilir. Yada ID00001 gibi artan bir numarada olabilir.
Kayıt düzeltme silme işlemlerinde bu ID kullanılacak.
Aynı zamanda diğer aylara taksitleri dağıtırken de ilk taksit için verdiğiniz bu ID kullanılacak.
Bu şekilde siz girilen aydaki taksitli bir işlemi sildiğinizde bu ID sayesinde diğer aylardaki taksitlerde bulunup silinebilecek.

Programınız bu şekilde çalıştıktan sonra tekrar yazın.

 

[s.savas]

Öncelikle programınızı referans (ID) numarasına göre yeniden düzenleyin.
Tüm aylarda ID kolonu olsun. Bu numara sadece o kayda özel olmalı. aynı ayda yada farklı bir ayda bu ID ile kayıt yapılmamış olmalı.
Her kayıtta artan bir numara olabilir. Yada ID00001 gibi artan bir numarada olabilir.
Kayıt düzeltme silme işlemlerinde bu ID kullanılacak.
Aynı zamanda diğer aylara taksitleri dağıtırken de ilk taksit için verdiğiniz bu ID kullanılacak.
Bu şekilde siz girilen aydaki taksitli bir işlemi sildiğinizde bu ID sayesinde diğer aylardaki taksitlerde bulunup silinebilecek.

Programınız bu şekilde çalıştıktan sonra tekrar yazın.

Her sayfaya A sütununa 1 den başlayarak otomatik sıra numarası veren kodu ID kodu verecek şekilde düzenledim, ancak bu kod bütün sayfalar için tekil olmadı. Çalışılan her ay için otomatik olarak ID00001 başlayıp +1 olacak şekilde yazdı.

son = Cells(Rows.Count, "b").End(xlUp).Row + 1
TextBox7.Value = "ID0000" & son - 1
Cells(son, "B").Value = TextBox7.Value 'kalan tutar
Cells(son, "B").HorizontalAlignment = xlLeft
Cells(son, "C").Value = CDate(TextBox1.Value) 'tarih
Cells(son, "C").HorizontalAlignment = xlCenter
Cells(son, "C").NumberFormat = "mm.dd.yyyy"
Cells(son, "D").Value = ComboBox1.Value 'kategori
Cells(son, "D").HorizontalAlignment = xlLeft
Cells(son, "E").Value = ComboBox2.Value 'alt kategori
Cells(son, "E").HorizontalAlignment = xlLeft
Cells(son, "F").Value = ComboBox3.Value 'harcama türü
Cells(son, "F").HorizontalAlignment = xlLeft
Cells(son, "G").Value = ComboBox4.Value 'harcama kalemi
Cells(son, "G").HorizontalAlignment = xlLeft
Cells(son, "H").Value = CCur(TextBox8.Value) 'taksit tutarı
Cells(son, "H").HorizontalAlignment = xlRight
Cells(son, "I").Value = TextBox3.Value 'taksit sayısı
Cells(son, "I").HorizontalAlignment = xlCenter
Cells(son, "J").Value = TextBox4.Value 'ödenen taksit
Cells(son, "J").HorizontalAlignment = xlCenter
Cells(son, "K").Value = TextBox5.Value 'kalan taksit
Cells(son, "K").HorizontalAlignment = xlCenter
Cells(son, "L").Value = CCur(TextBox6.Value) 'kalan tutar
Cells(son, "L").HorizontalAlignment = xlRight

 

[Asri]

O şekilde olmaz.

Numarator ile ilgili bir çalışma yapmıştım.
ID0001 arttırınca ID0010 gibi arttırması lazım önceden yazdığım kodlar bu işlemi yapıyor.
Ayarlar sayfası A2 hücresine ID000001 yazın. Daha sonra,
siz her yeni numara vereceğiniz zaman ayarlar sayfası A2 deki numarayı numarator verin ve onu bri arrtırsın
daha sonra arttırılın bu numarayı kullanın.

Karışık numaratör, numara arttırıcı fonksiyonu

Yazacağım bir program için numaratöre ihtiyacım oldu. Aşağıdaki şekilde bir fonksiyon yazdım. sayılar ve harfler karışık numarayı numaratör olarak kullanabilirsiniz. Harfler ve sayilar metin değişkenlerinin içeriklerini istediğiniz formata göre değiştirebilirsiniz. Numaratör arttırma işlemi...

excel.web.tr