Ví dụ chúng ta có 1 sheet dữ liệu của khách hàng như hình dưới

• Cột thứ nhất là ngày tháng giao dịch với khách hàng (sắp xếp theo ngày tăng dần)

• Cột thứ hai là số tiền phải thu của khách hàng (ghi nợ)

• Cột thứ ba là số đã thu được của khách hàng (ghi có)

• Cột thứ tư là cột thứ 2 trừ cột thứ 3

• Cột thứ năm là cân đối còn phải thu sau từng giao dịch, cột 6 là ghi chú

Việc tính toán chỉ cần cột 1 đến cột 4.

Tạo hàm

1. Function OldOfDebt(mRange As Range, toDate As Date) As Double

Hàm này trả về tuổi của khoản phải thu theo ngày, bằng cách giải đáp số dư còn phải thu tại ngày cuối cùng là các khoản phải thu của các ngày nào theo nguyên tắc khoản đã thu được sẽ là thanh toán cho khoản phải thu đến trước, sau đó tính ra số ngày theo trọng số của từng khoản đối với số dư.

Hàm có hai tham số, thứ nhất mRange chính là vùng tính toán, trong ví dụ là A2:D13; thứ hai toDate là ngày để xác định tuổi (toDate phải lớn hơn ngày cuối cùng phát sinh giao dịch với khách hàng), trong hình là C19. Theo ví dụ hàm tính tuổi của khoản phải thu có giá trị 191.000 là 146,36 ngày trả về tại ô E19.

2. Function AvgBalance(mRange As Range, toDate As Date) As Double

Hàm này có tham số y hệt hàm trên, trả về số dư còn phải thu trung bình của các khách hàng theo tỷ trọng về thời gian. Trong hình, hàm tính ra số dư bình quân trả về ô E21 là 106.791 với mRange là A2:D13 và toDate là 31/12/2005. (Bạn có thể tính được tổn thất do khách hàng này chiếm dụng bằng Hàm x lãi suất trong khoảng thời gian A2 đến A13).

Mã nguồn

Public Function OldOfDebt(mRange As Range, toDate As Date) As Double

Dim rDate As Range Cot ngay

Dim rDebit As Range Cot ghi no

Dim rCredit As Range Cot ghi co

Dim mPaid As Double Tong so da thu duoc

Dim mClose As Double So du cuoi tai ngay toDate

Dim mAccDebit As Double Debit cong don

Dim thisAmount As Double

Dim thisDate As Double

Dim mRow As Long Bien dem so dong

Dim i As Long

Dim ret As Double Gia tri tro ve

mRow = mRange.Rows.Count

Set rDate = mRange.Range(Cells(1, 1), Cells(mRow, 1))

Set rDebit = mRange.Range(Cells(1, 2), Cells(mRow, 2))

Set rCredit = mRange.Range(Cells(1, 3), Cells(mRow, 3))

mPaid = Application.WorksheetFunction.Sum(rCredit)

mClose = Application.WorksheetFunction.Sum(rDebit) - Application.WorksheetFunction.Sum(rCredit)

For i = 1 To mRow

If rDebit.Cells(i, 1).Value <> 0 Then

mAccDebit = mAccDebit + rDebit.Cells(i, 1).Value

If mAccDebit > mPaid Then

thisAmount = Application.WorksheetFunction.Min(mAccDebit - mPaid, rDebit.Cells(i, 1).Value)

thisDate = rDate.Cells(i, 1).Value

ret = ret + thisAmount * (toDate - thisDate) / mClose

End If

End If

Next i

OldOfDebt = ret

End Function

Public Function AvgBalance(mRange As Range, toDate As Date) As Double

Dim rDate As Range

Dim rAmount As Range

Dim mRow As Long

Dim mLenght As Long quang thoi gian tu ngay dau den toDate

Dim i As Long

Dim ret As Double

mRow = mRange.Rows.Count

Set rDate = mRange.Range(Cells(1, 1), Cells(mRow, 1))

Set rAmount = mRange.Range(Cells(1, 4), Cells(mRow, 4))

mLenght = toDate - rDate.Cells(1, 1)

For i = 1 To mRow

ret = ret + rAmount.Cells(i, 1) * (toDate - rDate.Cells(i, 1)) / mLenght

Next i

AvgBalance = ret

End Function   

Thái An st