Borç Takip Dosyası

Açıklama
Aylık sabit bir maaşla çalışıyorsanız, her ay rutin olarak ödeyecek olduğunuz borçlarınızda sizi takip edecektir. Hesaplarımızı kayıt altında tutarak dengeyi sağlamak ta pek mümkün değil. 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:
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)
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)
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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.ScreenUpdating = False
Calculate
'Application.ScreenUpdating = True
End Sub
İndirmek için tıklayınız...
Post a Comment