[Help] Giúp code tổng hợp số liệu tài khoản kế toán từ sổ NKC (1 người xem)

[hoangtrong_vbnd]

E có file excel nhật ký chung, tổng hợp phát sinh đối ứng mà dùng công thức chạy thì hơi chậm. Nhờ các bác chuyển giúp e sang vba chạy cho ngon. E cảm ơn !

 

[Ba Tê]

E có file excel nhật ký chung, tổng hợp phát sinh đối ứng mà dùng công thức chạy thì hơi chậm. Nhờ các bác chuyển giúp e sang vba chạy cho ngon. E cảm ơn !

Vì không phải trong ngành nên chưa hiểu lắm.
Xem tạm file này, chờ người khác viết VBA chạy "ngon" hơn.

 

[sealand]

Vì không phải trong ngành nên chưa hiểu lắm.
Xem tạm file này, chờ người khác viết VBA chạy "ngon" hơn.

Bác Ba Te là nhà giáo mà làm Kế toán ngon nhỉ. Nói chung thống kê dạng này em thấy dùng Dic khá an toàn.
Em ké thêm code của bác cải tiến không dùng mảng kết quả mà tổng hợp luôn vào Item của Dic và Item của Dic là mảng luôn. Đây là tuyệt chiêu khá hay mà đã có lần bác Phạm Thành Mỹ đã đề cập trên GPE.
Đồng thời em bỏ các phần dư của code. Mọi người tham khảo nha

Sub GPE()
Dim Dic As Object, Tm, Tk1, Tk2, i
Set Dic = CreateObject("Scripting.Dictionary")
Tm = Sheet03.Range(Sheet03.[H8], Sheet03.[J8].End(xlDown))
Tk1 = Sheet08.[B4].Value
For i = 1 To UBound(Tm, 1)
'PS No
If Left(Tm(i, 1), 3) = Tk1 Then
Tk2 = Left(Tm(i, 2), 3)
If Not Dic.exists(Tk2) Then
Dic.Add Tk2, Array(Tk2, 0, 0)
End If
Dic.Item(Tk2) = Array(Dic.Item(Tk2)(0), Dic.Item(Tk2)(1) + Tm(i, 3), Dic.Item(Tk2)(2))
End If


'PS Co
If Left(Tm(i, 2), 3) = Tk1 Then
Tk2 = Left(Tm(i, 1), 3)
If Not Dic.exists(Tk2) Then
Dic.Add Tk2, Array(Tk2, 0, 0)
End If
Dic.Item(Tk2) = Array(Dic.Item(Tk2)(0), Dic.Item(Tk2)(1), Dic.Item(Tk2)(2) + Tm(i, 3))
End If
Next
'Chep vao sheet
Tm = Dic.Items
Sheet08.[B8].Resize(92, 3).ClearContents
For i = 0 To Dic.Count - 1
Sheet08.Cells(i + 8, "B").Resize(, 3) = Tm(i)
Next
    Sheet08.Range("B8").Resize(i, 3).Sort Key1:=Sheet08.Range("B8"), Order1:=xlAscending
    Sheet08.Rows("8:" & 8 + i).EntireRow.Hidden = False
    Sheet08.Rows(i + 9 & ":100").Hidden = True
End Sub

 

[hoangtrong_vbnd]

E cảm ơn các bác .
Các bác xem giúp e trên ô B4 nếu nhập tài khoản chi tiết cũng chạy ra được ko ak.
Ví dụ: 622 - 6222 - 62221 nếu có bên nhật ký chung đều sử dụng để xem bên sheet "tkcap1"

 

[hoangtrong_vbnd]

Phiền các bác giúp e thêm 1 chút với. Làm sao để điều kiện đầu vào ô [B4] là mấy ký tự cũng lọc được.
Ví dụ nhập 11 - 111 – 1112
E cảm ơn !

 

[sealand]

Bạn sửa như sau để xem TK bất kỳ, mức chi tiết thực tế:

Sub GPE()
Dim Dic As Object, Tm, Tk1, Tk2, L, i
Set Dic = CreateObject("Scripting.Dictionary")
Tm = Sheet03.Range(Sheet03.[H8], Sheet03.[J8].End(xlDown))
Tk1 = Sheet08.[B4].Value
L = Len(Tk1)
For i = 1 To UBound(Tm, 1)
'PS No
If Left(Tm(i, 1), L) = Tk1 Then
Tk2 = Tm(i, 2)
If Not Dic.exists(Tk2) Then
Dic.Add Tk2, Array(Tk2, 0, 0)
End If
Dic.Item(Tk2) = Array(Dic.Item(Tk2)(0), Dic.Item(Tk2)(1) + Tm(i, 3), Dic.Item(Tk2)(2))
End If

'PS Co
If Left(Tm(i, 2), L) = Tk1 Then
Tk2 = Tm(i, 1)
If Not Dic.exists(Tk2) Then
Dic.Add Tk2, Array(Tk2, 0, 0)
End If
Dic.Item(Tk2) = Array(Dic.Item(Tk2)(0), Dic.Item(Tk2)(1), Dic.Item(Tk2)(2) + Tm(i, 3))
End If
Next
'Chep vao sheet
Tm = Dic.Items
Sheet08.[B8].Resize(92, 3).ClearContents
For i = 0 To Dic.Count - 1
Sheet08.Cells(i + 8, "B").Resize(, 3) = Tm(i)
Next
    Sheet08.Range("B8").Resize(i, 3).Sort Key1:=Sheet08.Range("B8"), Order1:=xlAscending
    Sheet08.Rows("8:" & 8 + i).EntireRow.Hidden = False
    Sheet08.Rows(i + 9 & ":100").Hidden = True
End Sub

 

[hoangtrong_vbnd]

Các bác chia sẻ giúp e 1 vấn đề này để e hiểu thêm và cách khắc phục nó được ko.
Đó là nếu e sử dụng button cho các đoạn mã thì code chạy bình thường nhưng nếu dùng Private thay đổi sự kiện thì đôi lúc excel nó ko chạy code và mở các file khác dùng sự kiện Private nó cũng không chạy luôn.

Private Sub WorkSheet_Change(ByVal Target As Range)
If Target.Address = "$B$4" Then THDU_GPE
End Sub

Các bác chia sẻ giúp e đối với những trường hợp như thế này thì xử lý làm sao được ko. E cảm ơn !