Kiểm tra giúp code tính toán số dư đầu kỳ

[bebo021999]

Bebo đang thử viết code để tính số dư đầu kỳ các tài khoản trong BCĐPS.

Sub daukyno()
Dim i, j As Integer
Dim Dat As String
Dim Rng2 As String
Application.ScreenUpdating = False
Worksheets("phatsinh").Activate
For i = 10 To Range("c65000").End(xlUp).Row
    Dat = "C" & CStr(i)
        If Worksheets("phatsinh").Range(Dat).Value < Worksheets("CDTK").Range("f3").Value Then
            Worksheets("CDTK").Activate
            For j = 10 To Range("b6500").End(xlUp).Row
                Rng2 = "B" & CStr(j)
                  If Range(Rng2).Value = Range(Dat).Offset(, 2).Value Then
                    Range(Rng2).Offset(, 2).Value = Range(Dat).Offset(, 5).Value
                  End If
            Next j
        End If
    Next i
End Sub

Nhưng không ra kết quả.
Nhờ mọi người test giúp. Xin cám ơn.

 

[nmhung49]

Nhân tài như lá mùa thu...
Cáo cao thủ online quá trời nè..

BeBo chơi khích nữa ta

 

[bebo021999]

Thanks nmhung49, không để ý mấy cái cột bị hide, dùng offset hoài không ra.

 

[ThuNghi]

Bebo đang thử viết code để tính số dư đầu kỳ các tài khoản trong BCĐPS.

Sub daukyno()
Dim i, j As Integer
Dim Dat As String
Dim Rng2 As String
Application.ScreenUpdating = False
Worksheets("phatsinh").Activate
For i = 10 To Range("c65000").End(xlUp).Row
    Dat = "C" & CStr(i)
        If Worksheets("phatsinh").Range(Dat).Value < Worksheets("CDTK").Range("f3").Value Then
            Worksheets("CDTK").Activate
            For j = 10 To Range("b6500").End(xlUp).Row
                Rng2 = "B" & CStr(j)
                  If Range(Rng2).Value = Range(Dat).Offset(, 2).Value Then
                    Range(Rng2).Offset(, 2).Value = Range(Dat).Offset(, 5).Value
                  End If
            Next j
        End If
    Next i
End Sub

Nhưng không ra kết quả.
Nhờ mọi người test giúp. Xin cám ơn.

Bebo có tính đến phương án TK ở sh PS kg có trong Sh CDTK? Còn hiển nhiên TK sh CDTK là phải bao gồm TK trong Sh PS.
Sao chỉ làm có đầu kỳ mà không làm PS.
Và nếu viết code thì còn dùng hơi nhiều name.
Đã nghiên cứu thì nên nghiên cứu cái mới là Dic luôn. Dùng "bá cháy". Tôi thấy còn dễ hiểu hơn range, offset ...
Vài lời góp ý và "chọt". Sorry nhé.
mhung viết code theo hướng Dic file trên thử xem.

 

[ptm0412]

Bebo sai nhiều chứ không chỉ sai code:

1. Sai về định nghĩa số dư đầu kỳ:
Số dư đầu ngày N phải tính bằng công thức:
Số dư nợ DK ngày N = Số dư nợ ngày 0 + Tổng PS nợ ngày nhỏ hơn N - Tổng PS có ngày nhỏ hơn N
Số dư có DK ngày N = Số dư có ngày 0 + Tổng PS có ngày nhỏ hơn N - Tổng PS nợ ngày nhỏ hơn N
Nếu tính cột này xong mà âm, thì phải ghi vào cột kia.

Nếu mặc định ngày 0 có số dư zero thì vẫn phải tính tổng PS nợ và tổng PS có, 2 cái cấn trừ nhau.

2. Sai trong thuật toán:
- Từ định nghĩa sai, dẫn đến thuật toán sai (đương nhiên): Chỉ tính PS nợ, không ngó tới PS có.
- Chỉ tính PS nợ, nhưng không tính tổng, mà duyệt qua dữ liệu, hễ thoả điều kiện là ghi vào ô. Duyện dòng kế mà gặp nữa, lại ghi đè lên.
Kết quả: Số dư nợ ngày N = số phát sinh ngày cuối cùng trước ngày N

3. Các câu lệnh trong code chưa gọn gàng

 

[ThuNghi]

Bebo sai nhiều chứ không chỉ sai code:

1. Sai về định nghĩa số dư đầu kỳ:
Số dư đầu ngày N phải tính bằng công thức:
Số dư nợ DK ngày N = Số dư nợ ngày 0 + Tổng PS nợ ngày nhỏ hơn N - Tổng PS có ngày nhỏ hơn N
Số dư có DK ngày N = Số dư có ngày 0 + Tổng PS có ngày nhỏ hơn N - Tổng PS nợ ngày nhỏ hơn N
Nếu tính cột này xong mà âm, thì phải ghi vào cột kia.

Nếu mặc định ngày 0 có số dư zero thì vẫn phải tính tổng PS nợ và tổng PS có, 2 cái cấn trừ nhau.

2. Sai trong thuật toán:
- Từ định nghĩa sai, dẫn đến thuật toán sai (đương nhiên): Chỉ tính PS nợ, không ngó tới PS có.
- Chỉ tính PS nợ, nhưng không tính tổng, mà duyệt qua dữ liệu, hễ thoả điều kiện là ghi vào ô. Duyện dòng kế mà gặp nữa, lại ghi đè lên.
Kết quả: Số dư nợ ngày N = số phát sinh ngày cuối cùng trước ngày N

3. Các câu lệnh trong code chưa gọn gàng

E lây cái code này e đã làm gắn vào file trên chạy thử. bạn Bebo này thử anh em phải sửa A39 sh phát sinh từ 29/02/2010 thành 28/02/2010.
Code như sau

Sub TaoCD()
Dim endR&, i&, s&, nR&, eDate&, fDate&, iDate&
Dim sTK$, sTKNo$, sTKCo$, SoDu As Double
Dim Arr(), ArrKQ()
Dim Dic As Object, Wf As WorksheetFunction
Set Dic = CreateObject("Scripting.Dictionary")
Set Wf = WorksheetFunction
Const ColNg = 3: Const ColNo = 10: Const ColCo = 11: Const ColSt = 12
With Sheets("CDTK")
  endR = .Cells(65000, 1).End(xlUp).Row
  Arr = .Range("B10:B" & endR).Value
  fDate = CLng(.[F3]): eDate = CLng(.[G3])
  If eDate < fDate Then eDate = fDate
End With
s = 0
For i = 1 To UBound(Arr)
  sTK = CStr(Arr(i, 1))
  If Not Dic.Exists(sTK) Then
    s = s + 1
    Dic.Add sTK, s
  End If
Next i
With Sheets("PHATSINH")
  endR = .Cells(65000, ColSt).End(xlUp).Row
  Arr = .Range("A10:L" & endR).Value
End With
ReDim ArrKQ(1 To UBound(Arr), 1 To 6)
For i = 1 To UBound(Arr)
  iDate = CLng(Arr(i, ColNg))
  sTKNo = CStr(Arr(i, ColNo)): sTKCo = CStr(Arr(i, ColCo))
  If iDate <= eDate Then
    'Phan No
    If Dic.Exists(sTKNo) Then
      nR = Dic.Item(sTKNo)
      'Phan SDDK No
      If CLng(Arr(i, ColNg)) < fDate Then
        ArrKQ(nR, 1) = ArrKQ(nR, 1) + Arr(i, ColSt)
      End If
      'Phan Phat Sinh No
      If CLng(Arr(i, ColNg)) >= fDate Then
        ArrKQ(nR, 3) = ArrKQ(nR, 3) + Arr(i, ColSt)
      End If
    End If
    'Phan Co
    If Dic.Exists(sTKCo) Then
      nR = Dic.Item(sTKCo)
      'Phan SDDK Co
      If CLng(Arr(i, ColNg)) < fDate Then
        ArrKQ(nR, 2) = ArrKQ(nR, 2) + Arr(i, ColSt)
      End If
      'Phan Phat Sinh Co
      If CLng(Arr(i, ColNg)) >= fDate Then
        ArrKQ(nR, 4) = ArrKQ(nR, 4) + Arr(i, ColSt)
      End If
    End If
  End If
Next i
'Phan xu ly SDDK va SDCK
For i = 1 To Dic.Count
  'Phan sddk
  SoDu = ArrKQ(i, 1) - ArrKQ(i, 2)
  ArrKQ(i, 1) = Wf.Max(SoDu, 0) 'SDDK No
  ArrKQ(i, 2) = Wf.Max(-SoDu, 0) 'SDDK Co
  'Phan sdck
  SoDu = (ArrKQ(i, 1) + ArrKQ(i, 3)) - (ArrKQ(i, 2) + ArrKQ(i, 4))
  ArrKQ(i, 5) = Wf.Max(SoDu, 0)
  ArrKQ(i, 6) = Wf.Max(-SoDu, 0)
Next i
With Sheets("CDTK")
  .[D10].Resize(Dic.Count, 6) = ArrKQ
End With
Erase Arr(), ArrKQ()
Set Dic = Nothing: Set Wf = Nothing

End Sub

Bỏ cái cột lũy kế PS nhé.