Gönderen Konu: Borç Takip Dosyası  (Okunma sayısı 5198 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Çevrimdışı kodgentr

  • Excel Ötesi
  • *
  • İleti: 12
  • Puan +1/-0
  • Cinsiyet: Bay
  • Excel'den Daha Fazlası!..
    • www.kabatasliyiz.biz
  • Ad Soyad: ahmet aşkın küçükkaya
  • Mesleğiniz: Kamu
Borç Takip Dosyası
« : 15 Eylül 2010, 21:45:06 »
Aylık sabit bir maaşla çalışıyorsanız, aldığınız maaş ve her ay rutin olarak ödenen borçlarınızda maalesef sizi takip edecektir. Her ne kadar hesaplarımızı kayıt altında tutsakda dengeyi sağlamak pek mümkün olmuyor.


Eğer sizde borçlarınızı bir excel sayfasından takip etmek istiyorsanız bu küçük dosya işinize yarayacaktır. Dosyanın yaptığı işlem basit. Sadece yeşil renkli rakamları topluyor. Siz ödediğiniz veya ödeyeceğiniz borcu yeşil yapıyorsunuz, diğer hesaplama işlemleri excel vba kodları sayesinde otomatik yapılıyor.


Modules'e yazılacak kodlar:

Kod: [Seç]
Function ColorSum(rngCells As Range) As Double
Application.Volatile
Dim cell As Range
ColorSum = 0 'Toplamaya kaçtan başlanacak
On Error Resume Next
For Each cell In rngCells
If cell.Font.ColorIndex = 10 Then ColorSum = ColorSum + cell.Value
Next cell
End Function

Function SumColor(rColor As Range, rSumRange As Range)

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com

'Sums cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
Dim rCell As Range
Dim iCol As Integer
Dim vResult

iCol = rColor.Interior.ColorIndex

For Each rCell In rSumRange
If rCell.Interior.ColorIndex = iCol Then
vResult = WorksheetFunction.Sum(rCell) + vResult
End If
Next rCell

SumColor = vResult
End Function
Function CountColor(rColor As Range, rSumRange As Range)

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com

'Counts cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
Dim rCell As Range
Dim iCol As Integer
Dim vResult

iCol = rColor.Interior.ColorIndex

For Each rCell In rSumRange
If rCell.Interior.ColorIndex = iCol Then
vResult = vResult + 1
End If
Next rCell

CountColor = vResult
End Function

Borç sayfasına yazılacak kodlar

Kod: [Seç]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.ScreenUpdating = False
Calculate
'Application.ScreenUpdating = True
End Sub

    Dosyayı indir

Çevrimdışı Bülent Öztürk

  • Excelce.Net Yönetici
  • *
  • İleti: 1318
  • Puan +19/-0
  • Cinsiyet: Bay
  • Türkçe Konuşup Excelce Yazıyoruz...
    • Bülent Öztürk
  • Ad Soyad: Bülent Öztürk
  • İl / İlçe: İstanbul / Çorlu
  • İşletim Sisteminiz: Win.10
  • Mesleğiniz: Bilgi Teknolojileri
  • Office Versiyonunuz: Office2013/2016
Ynt: Borç Takip Dosyası
« Yanıtla #1 : 16 Eylül 2010, 11:05:04 »
Paylaşım için teşekkürler Aşkın Bey.  :begendim
=EĞER(EYOKSA("Google Arama");"Belki_Cevap_Burada";"")

Çevrimdışı kodgentr

  • Excel Ötesi
  • *
  • İleti: 12
  • Puan +1/-0
  • Cinsiyet: Bay
  • Excel'den Daha Fazlası!..
    • www.kabatasliyiz.biz
  • Ad Soyad: ahmet aşkın küçükkaya
  • Mesleğiniz: Kamu
Ynt: Borç Takip Dosyası
« Yanıtla #2 : 17 Eylül 2010, 09:36:28 »
Rica ederim. :begendim