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
Nhờ các bạn giúp đỡ như sau:
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 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
- Cải tiến để code chạy nhanh hơn
- 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)
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.