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

S

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Altın Üyelik Bitiş Tarihi
07-02-2024
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.
222186
 

Ekli dosyalar

Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,680
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
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)

C++: 
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
 
T

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,849
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
12-02-2029
Merhaba Asri Hocam,
KTF ler nasıl çalışıyor?
Saygılarımla
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,680
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Tevfik_Kursun' Alıntı:
Merhaba Asri Hocam,
KTF ler nasıl çalışıyor?
Saygılarımla
Genişletmek için tıkla ...
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

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Altın Üyelik Bitiş Tarihi
07-02-2024
Asri' Alıntı:
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)

C++: 
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
Genişletmek için tıkla ...
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.
C++: 
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

Asri

Katılım
24 Nisan 2005
Mesajlar
3,680
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
s.savas' Alıntı:
Burada ktf yi nasıl kullanırız bilemedim.
Genişletmek için tıkla ...
Ö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

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
Altın Üyelik Bitiş Tarihi
07-02-2024
Asri' Alıntı:
Ö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.
Genişletmek için tıkla ...
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ı.
C++: 
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

Asri

Katılım
24 Nisan 2005
Mesajlar
3,680
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
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 excel.web.tr
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst