Cho ý kiền & chỉnh sửa code của Bảng CĐPS của các tháng (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

dongducnhiem

Thành viên tiêu biểu
Tham gia
21/3/07
Bài viết
637
Được thích
378
Chào các bạn thành viên!
Tôi có viết code tạo Bảng Cân Đối Phát Sinh, nhưng do trình độ hạn chế nên chỉ chuyển công thức qua Code để file giảm nhẹ dung lượng & nhanh hơn 1 tý. Thời gian mỗi khi chạy code khoảng 1~2 phút. Các bạn thử bấm nút “ Cập nhật” ở các Sheet PST01, PST02, PST03

PHP:
Sub TaoCDPS_T()
'Tao tu cot C den Cot H cua cac Sheet PST01, PST02...
Dim StartTime As Double
StartTime = Timer
  On Error Resume Next
      Application.ScreenUpdating = False
  Range("C10:H159").ClearContents
  With Range([B9], [B200].End(xlUp))
    .Parent.ShowAllData
    ' Ket chuyen so du dau ky
    .Offset(1, 1).Value = "=IF(ISNA(VLOOKUP(B10,CDPS,6,0)),0,VLOOKUP(B10,CDPS,6,0))"
    .Offset(1, 2).Value = "=IF(ISNA(VLOOKUP(B10,CDPS,7,0)),0,VLOOKUP(B10,CDPS,7,0))"
    ' Tinh so phat sinh
    .Offset(1, 3).Value = "=SUMPRODUCT((LEFT((II)*1,LEN(B10))*1=B10)*(EE=$B$9 )*(KK))"
    .Offset(1, 4).Value = "=SUMPRODUCT((LEFT((JJ)*1,LEN(B10))*1=B10)*(EE=$B$9 )*(KK))"
    ' Tinh so du cuoi ky
        
    .Offset(1, 5).Value = "=MAX(C10-D10+E10-F10,0)"
    .Offset(1, 6).Value = "=MAX(D10+F10-C10-E10,0)"
    
    With ActiveSheet
     'Tinh total cac khoan muc
        .Range("E10").Resize(, 4).Formula = "=(R11C+R14C+R17C+R18C+R21C+R24C+R27C+R30C+R31C+R32C+R33C+R34C+R38C+R39C+R42C)"
        .Range("E43").Resize(, 4).Formula = "=(R44C+R51C+R55C+R59C+R63C+R64C+R50C)"
        .Range("E65").Resize(, 4).Formula = "=(R66C+R67C+R68C+R69C+R75C+R76C+R77C+R78C+R85C+R86C)"
        .Range("E89").Resize(, 4).Formula = "=(R90C+R91C+R92C+R94C)"
        .Range("E97").Resize(, 4).Formula = "=(R98C+R102C+R103C+R104C)"
        .Range("E105").Resize(, 4).Formula = "=(R106C+R110C+R114C+R121C+R130C+R134C+R135C+R143C)"
        .Range("E151").Resize(, 4).Formula = "=(R152C)"
        .Range("E153").Resize(, 4).Formula = "=(R154C+R155C)"
        .Range("E157").Resize(, 4).Formula = "=(R158C)"
    End With
    ' Tinh Total cua bang tinh
    .Offset(.Rows.Count, 1).Resize(1, 6).Value = "=SUM(R10C,R43C,R65C, R89C,R97C,R105C,R151C,R153C,R157C)"
    
    With .Resize(, 7)
     .Value = .Value
    End With
    
  End With
  Application.ScreenUpdating = True
  MsgBox Format(Timer - StartTime, "00.00") & " giây."
End Sub
Nhờ các bạn giúp đỡ như sau:

  1. Cải tiến để code chạy nhanh hơn
  2. Code trong trường hợp này, nếu ta thêm dòng ở các Sheet PST01, PST02… thì phần tính Total của các khoản mục này sẽ bị sai. Vậy có thể sửa như thế nào để khi người khác thêm dòng thì code chạy vẫn đúng? (Ví dụ: Dòng 15 “Tiền VN” có tài khoản 1121, bây giờ ta thêm 02 tài khỏan con là 11211 và 11212, Vui lòng xem Sheet PST04)
Các bạn giúp mình phần (1) hoặc (2) cũng được
Xin cảm ơn!
---------------------------
P/s: - Tôi vẫn muốn giữ nguyên cấu trúc bảng cân đối phát sinh & số lượng Sheet PST của các tháng. Vì tôi phải tính thêm các phân bổ & yêu cầu khác
- File đang ở chế độ Manual.
 

File đính kèm

Chào các bạn thành viên!
Tôi có viết code tạo Bảng Cân Đối Phát Sinh, nhưng do trình độ hạn chế nên chỉ chuyển công thức qua Code để file giảm nhẹ dung lượng & nhanh hơn 1 tý. Thời gian mỗi khi chạy code khoảng 1~2 phút. Các bạn thử bấm nút “ Cập nhật” ở các Sheet PST01, PST02, PST03
...
Nhờ các bạn giúp đỡ như sau:

  1. Cải tiến để code chạy nhanh hơn
  2. Code trong trường hợp này, nếu ta thêm dòng ở các Sheet PST01, PST02… thì phần tính Total của các khoản mục này sẽ bị sai. Vậy có thể sửa như thế nào để khi người khác thêm dòng thì code chạy vẫn đúng? (Ví dụ: Dòng 15 “Tiền VN” có tài khoản 1121, bây giờ ta thêm 02 tài khỏan con là 11211 và 11212, Vui lòng xem Sheet PST04)
Các bạn giúp mình phần (1) hoặc (2) cũng được
Xin cảm ơn!
---------------------------
P/s: - Tôi vẫn muốn giữ nguyên cấu trúc bảng cân đối phát sinh & số lượng Sheet PST của các tháng. Vì tôi phải tính thêm các phân bổ & yêu cầu khác
- File đang ở chế độ Manual.

Tôi hiểu thế này có đúng không?
1/ Căn cứ 2 số cuối tên sh => Tháng cần lấy PS và -1 => lấy đầu kỳ.
2/ Phần lấy Phát sinh sẽ lấy từ sh Data, bạn dùng dùng sumproduct.
Đề xuất hương xử lý theo tôi có vẻ tổng quan hơn và kg thay đổi cấu trúc báo cáo.
1/ Nên có 1 cột phụ để phân biệt TK cấp 1, cấp 2 và cấp 3
Trong đó
- Cấp 1 là những số Roman (OK)
- Cấp 2 là những TK là tập hợn những TK cấp 3, vd cấp 2 là 211 thì cấp 3 là 2111, 2112...
- Cấp 3 là những tk lấy số liệu trực tiếp từ Data.
2/ Phần sum từng cấp thì dùng subtotal.
Làm như vậy khi bạn thêm dữ liệu và chỉ rõ cấp thì sẽ kg sai kết quả.
 
Upvote 0
Tôi hiểu thế này có đúng không?
1/ Căn cứ 2 số cuối tên sh => Tháng cần lấy PS và -1 => lấy đầu kỳ.
2/ Phần lấy Phát sinh sẽ lấy từ sh Data, bạn dùng dùng sumproduct.
Đề xuất hương xử lý theo tôi có vẻ tổng quan hơn và kg thay đổi cấu trúc báo cáo.
1/ Nên có 1 cột phụ để phân biệt TK cấp 1, cấp 2 và cấp 3
Trong đó
- Cấp 1 là những số Roman (OK)
- Cấp 2 là những TK là tập hợn những TK cấp 3, vd cấp 2 là 211 thì cấp 3 là 2111, 2112...
- Cấp 3 là những tk lấy số liệu trực tiếp từ Data.
2/ Phần sum từng cấp thì dùng subtotal.
Làm như vậy khi bạn thêm dữ liệu và chỉ rõ cấp thì sẽ kg sai kết quả.
Số dư đầu kỳ của tháng : Ví dụ: tháng 01 (Sheet PST01) khối cell như sau
PHP:
PST01!C10:D158 = PST00!G10:H158

Đồng ý với bạn thêm một cột phụ, nhưng vui lòng để cột phụ này ở cột Z
Xin cảm ơn.
 
Upvote 0
Bạn ThuNghi xin vui lòng lưu ý giùm, trong Bảng cân đối tài khoản có các cấp như sau, ví dụ
Tài khỏan 627 "Chi phí SXC" -----> cấp 1
Tài khoản 6274 " Chi phí KH TSCĐ" ---------> Cấp 2
Tài khỏan 62741 " Chi phí KH TSCĐ Vận tải " ---------> Cấp 3
Và Tài khỏan 62742 " Chi phí KH TSCĐ Cơ giới " ---------> Cấp 3
----------
Sorry Bạn, vì buổi chiều bận quá, nên quên chuyển thông tin này đến bạn.
 
Upvote 0
Bạn ThuNghi xin vui lòng lưu ý giùm, trong Bảng cân đối tài khoản có các cấp như sau, ví dụ
Tài khỏan 627 "Chi phí SXC" -----> cấp 1
Tài khoản 6274 " Chi phí KH TSCĐ" ---------> Cấp 2
Tài khỏan 62741 " Chi phí KH TSCĐ Vận tải " ---------> Cấp 3
Và Tài khỏan 62742 " Chi phí KH TSCĐ Cơ giới " ---------> Cấp 3
----------
Sorry Bạn, vì buổi chiều bận quá, nên quên chuyển thông tin này đến bạn.
Tạm thời cứ xem
Những chữ số Roman là cấp 1
Những TK mà có len = 3 là cấp 2
Các TK khác bao gồm len >3 và = 3 là cấp 3. Những TK mà sh Data ghi PS No và có.
Cái vụ 6274 có thấy những thấy kg logich lắm nân chưa làm, cùng lắm thêm 1 cái ì là OK.
PHP:
Option Explicit
Sub TaoCanDoi()
Dim endR&, i&, s&, nR&, iM&, k&
Dim sTK$, sTkNo&, sTkCo&, sM$, shName$, oldShName$
Dim Arr, ArrTK, ArrSD, ArrKQ, ArrPS
Dim Dic As Object, Wf As WorksheetFunction
Dim StartTime As Double
StartTime = Timer
With Application
  .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
shName = ActiveSheet.Name
sM = Right(shName, 2)
If sM = "00" Or Left(shName, 3) <> "PST" Then
  Exit Sub
End If
oldShName = "PST" & Right("0" & sM - 1, 2)
'MsgBox sM
With Sheets(shName)
  endR = .Cells(1000, "B").End(3).Row
  ArrTK = .Range("B10:B" & endR).Value
End With
'Tao ArrTK
s = 0
Set Dic = CreateObject("Scripting.Dictionary")
Set Wf = WorksheetFunction
For i = 1 To UBound(ArrTK)
  sTK = CStr(ArrTK(i, 1))
  s = s + 1
  Dic.Add sTK, s
Next i
'Lay Data tu can doi thang truoc
With Sheets(oldShName)
  endR = .Cells(1000, "B").End(3).Row
  ArrSD = .Range("B10:H" & endR).Value
End With
ReDim ArrKQ(1 To UBound(ArrSD), 1 To 6)
'Lay sodk =sdck
For i = 1 To UBound(ArrSD)
  sTK = CStr(ArrSD(i, 1))
  nR = Dic.Item(sTK)
  ArrKQ(nR, 1) = ArrKQ(nR, 1) + ArrSD(i, 6) 'DK NO
  ArrKQ(nR, 2) = ArrKQ(nR, 2) + ArrSD(i, 7) 'DK CO
Next i
With Sheets("Data")
  endR = .Cells(65000, "K").End(3).Row
  Arr = .Range("B10:K" & endR).Value
End With
iM = Val(sM)
For i = 1 To UBound(Arr)
  If i > 1 And Month(Arr(i, 1)) > iM Then Exit For
  If Month(Arr(i, 1)) = iM Then
    'Phan PS No
    sTK = CStr(Arr(i, 8))
    nR = Dic.Item(sTK)
    If nR Then ArrKQ(nR, 3) = ArrKQ(nR, 3) + Arr(i, 10)
    'Phan PS No TK cap - Them phan TK Data co 3 ky tu
    If Len(sTK) > 3 Then
      sTK = Left(sTK, 3)
      nR = Dic.Item(sTK)
      If nR Then ArrKQ(nR, 3) = ArrKQ(nR, 3) + Arr(i, 10)
    End If
    'Phan PS Co
    sTK = CStr(Arr(i, 9))
    nR = Dic.Item(sTK)
    If nR Then ArrKQ(nR, 4) = ArrKQ(nR, 4) + Arr(i, 10)
    'Phan PS Co TK Cap
    If Len(sTK) > 3 Then
      sTK = Left(sTK, 3)
      nR = Dic.Item(sTK)
      If nR Then ArrKQ(nR, 4) = ArrKQ(nR, 4) + Arr(i, 10)
    End If
  End If
Next i
'Phan nay xu ly subtotal
For i = UBound(ArrKQ) To 1 Step -1
  If AscW(Left(ArrTK(i, 1), 1)) <> 73 Then
    If AscW(Left(ArrTK(i, 1), 1)) <> 86 Then 'I or II or V...
      ArrKQ(i, 5) = Wf.Max(0, ((ArrKQ(i, 1) + ArrKQ(i, 3)) - (ArrKQ(i, 2) + ArrKQ(i, 4))))
      ArrKQ(i, 6) = Wf.Max(0, -((ArrKQ(i, 1) + ArrKQ(i, 3)) - (ArrKQ(i, 2) + ArrKQ(i, 4))))
    End If
  End If
Next i
'Phan nay xu ly du ck
ReDim ArrPS(1 To 4)
For i = UBound(ArrKQ) To 1 Step -1
  If Len(ArrTK(i, 1)) = 3 Then
    For k = 1 To 4
      ArrPS(k) = ArrPS(k) + ArrKQ(i, k + 2)
    Next k
  End If
  If AscW(Left(ArrTK(i, 1), 1)) = 73 Or AscW(Left(ArrTK(i, 1), 1)) = 86 Then 'I or II or V...
    For k = 1 To 4
      ArrKQ(i, k + 2) = ArrPS(k)
    Next k
    ReDim ArrPS(1 To 4)
  End If
Next i
With Sheets(shName)
  .[C10].Resize(s, 6).ClearContents
  .[C10].Resize(s, 6) = ArrKQ
End With
Erase Arr, ArrTK, ArrSD, ArrKQ, ArrPS
Set Dic = Nothing: Set Wf = Nothing
With Application
  .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
MsgBox Format(Timer - StartTime, "00.00") & " giây."
End Sub
File không dùng thêm cột phụ nào.
Theo tôi, kg ai làm như bạn.
1/ Có Data là tổng hợp toàn bộ số PS.
2/ Có T00 là số đầu kỳ.
Vậy sao kg làm CDPS theo tháng xx và nếu cần thì tạo 1 copy sang sh khác.
Còn phần tổng hợp CP ... theo tôi cũng nên tổng hợp thành bảng khác vd THPhatSinh.
Bạn xem thử file. Buồn kg chuyện gì làm, "no body invite me to do ..." viết code
cho vui.
Tôi thấy bạn công thức khá siêu nên không nỡ bỏ cách dùng công thức.
Nên dùng code => tư duy mau hơn. Từ từ sẽ quen và lúc đó sẽ thích VBA hơn.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Theo tôi, kg ai làm như bạn.
1/ Có Data là tổng hợp toàn bộ số PS.
2/ Có T00 là số đầu kỳ.
Vậy sao kg làm CDPS theo tháng xx và nếu cần thì tạo 1 copy sang sh khác.
Nên dùng code => tư duy mau hơn. Từ từ sẽ quen và lúc đó sẽ thích VBA hơn.
Xin cảm ơn tất cả sự nhiệt tình, công sức & thời gian của bạn để giúp đỡ tôi
Tôi fải làm sheet cân đối từng tháng vì
1/ Cty tôi có nhiều mãng, cụ thể:
A/Bộ phận vận tải (xe ben) phục vụ cho
- Vận chuyển chở VLXD đi bán
- Vận chuyển thuê
- vận chuyển trong xây lắp
B/ Bộ phận cơ giới (xe cuốc, lu, ủi ...) phục vụ cho
- Làm dịch vụ
- Làm xây lắp
..........

Như thế ta để tính được chi phí cho từng mãng trên thì ta fải fân bổ tiếp các chi phí như lương, nguyên nhiên liệu, khấu hao (đây là những chi fí chiếm tỷ trọng lớn) tiêu thức fân bổ của tôi là theo số lượng dầu DO mà mỗi mãng đã tiêu thụ. Lợi dụng Bảng cân đối đã tính tổng chi phí, ta làm thêm công thức kế bên để tính ra chi phí cho riêng từng mãng. Và sau này khi quyết toán thuế, nếu nhân viên thuế HẠCH HỎI thì ta có cái chứng minh !? (hic, bị nhiều rồi, không có hỏi cho có, có rồi thì hổng biết có đọc không, đọc xong hổng biết được mấy quý vị hiểu!? )

2/ Lập công thức kế bên Bảng cân đối để kiểm tra đối chiếu các giá trị ở các bảng khác như : VAT đầu ra đầu vào, tài khoản phân bổ 142, 242, khấu hao, nhập xuất kho ...

3/ Hàng quý còn phải " cân đối lãi lỗ cái sự đời" theo ý các quý sếp nữa ----> Vậy lại phải hạch toán lại từng tháng thôi

Híc muốn hiểu code của bạn thì fải nghiên cứu cái vụ "Dic" & "Array" rồi, trước đây đã nghiên cứu nhưng vẫn chưa được 1 thành công lực!

Trong code của bạn tôi thấy có
PHP:
=SUMPRODUCT((CODE($B$10:$B$159)>72)*(CODE($B$10:$B$159)<87)*(C$10:C$159))
Các thông số 73, 86 và 72, 87 là gì?

Vì chưa hiểu nhiều và fải ngâm cứu code của bạn, nên rất mong bạn giúp tôi thêm 1 lần nữa là sửa code để tính BẢNG CÂN ĐỐI PHÁT SINH CẢ NĂM, như sau:
a/ Tên Sheet là PST13, có cấu trúc giống như các tháng
b/ Số đầu năm của PST13 lấy từ số dư cuối tháng của Sheet PST00
Một lần nữa cảm ơn bạn và tất cả!
 
Upvote 0
Trong code của bạn tôi thấy có
PHP:
=SUMPRODUCT((CODE($B$10:$B$159)>72)*(CODE($B$10:$B$159)<87)*(C$10:C$159))
Các thông số 73, 86 và 72, 87 là gì?
Code("I")=73
I là số 1 la Mã
Code của V là 86
Tại bảng tính nhập thử =code(...)
Còn vấn đề là file kia đúng chưa? Đúng thì triển khai T13, "It's not big!"
 
Upvote 0
Cảm ơn bạn, Code chạy tốc độ & chính xác
Về triển khai PST13, có thể tôi sửa tính số dư đầu kỳ được, nhưng tính Phát sinh NỢ hay CÓ thì chưa nghĩ được vì code của bạn tính Month, còn bây giờ là Year. Bạn có thể giúp hoặc hướng dẫn được không!
 
Upvote 0
Cảm ơn bạn, Code chạy tốc độ & chính xác
Về triển khai PST13, có thể tôi sửa tính số dư đầu kỳ được, nhưng tính Phát sinh NỢ hay CÓ thì chưa nghĩ được vì code của bạn tính Month, còn bây giờ là Year. Bạn có thể giúp hoặc hướng dẫn được không!
Có sửa code trên 1 chút và là thêm code TaoCandoiNam, đáng ra chỉ cần làm 1 code cho cả 2.
Có gì chưa OK thì báo.
 

File đính kèm

Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom