phuongc5
Thành viên hoạt động



- Tham gia
- 26/10/07
- Bài viết
- 146
- Được thích
- 71
- Nghề nghiệp
- Kế toán
add-in sao nhung ham van ko thuc hien
Xin các huynh giúp 1 việc như sau:
Đệ có 1 code (nguồn lấy từ web 24h.com):
[FONT='.VnTime'][FONT='.VnTime'](http://www6.24h.com.vn/news.php/179/126291[/FONT]http://www6.24h.com.vn/news.php/179/126291)[/FONT]
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
Đệ đã add-in nhưng khi thực hiện thì máy báo hàm lỗi. xin các huynh xem rồi chỉ giúp. Đệ có đường link tới web 24h.com mà đã viết code này.
Xin các huynh giúp 1 việc như sau:
Đệ có 1 code (nguồn lấy từ web 24h.com):
[FONT='.VnTime'][FONT='.VnTime'](http://www6.24h.com.vn/news.php/179/126291[/FONT]http://www6.24h.com.vn/news.php/179/126291)[/FONT]
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
Đệ đã add-in nhưng khi thực hiện thì máy báo hàm lỗi. xin các huynh xem rồi chỉ giúp. Đệ có đường link tới web 24h.com mà đã viết code này.