Code VBA cộng tổng trên bảng CĐKT (1 người xem)

[hieuvietmy2020]

Em chào Anh Chị trên diễn đàn,

Em có viết đoạn code để lấy kết quả từ bảng Cân đối phát sinh qua bảng Cân đối kế toán, số chi tiết và Total 1 em đã code được, Total 2 em chưa đúng logic, nhờ Anh Chị hướng dẫn thêm giúp em 2 vấn đề sau:
1. Ô màu vàng là kết quả mong muốn với code chưa đúng logic ở Sub CDKT2()
2. Sub phụ là CDKT1() và CDKT2(), em đang dùng để tính tổng sau khi lấy số từ Sheets("CDPS") sang, nếu em lồng vào Sub chính là CDKT0() thì phải Run 2 lần mới có kết quả cuối cùng (Anh Chị gợi ý thêm giúp em đoạn này)

Em cảm ơn Anh Chị đã xem bài!

 

[DeTong]

Em chào Anh Chị trên diễn đàn,

Em có viết đoạn code để lấy kết quả từ bảng Cân đối phát sinh qua bảng Cân đối kế toán, số chi tiết và Total 1 em đã code được, Total 2 em chưa đúng logic, nhờ Anh Chị hướng dẫn thêm giúp em 2 vấn đề sau:
1. Ô màu vàng là kết quả mong muốn với code chưa đúng logic ở Sub CDKT2()
2. Sub phụ là CDKT1() và CDKT2(), em đang dùng để tính tổng sau khi lấy số từ Sheets("CDPS") sang, nếu em lồng vào Sub chính là CDKT0() thì phải Run 2 lần mới có kết quả cuối cùng (Anh Chị gợi ý thêm giúp em đoạn này)

Em cảm ơn Anh Chị đã xem bài!

Theo tôi thì viết code cho CDPS là đúng;
Sheet CDKT thì chỉ cần Vlookup là Ok rồi.
Sheet CDKT thiếu mã số 138 nên Sum thiếu...

 

[HieuCD]

Em chào Anh Chị trên diễn đàn,

Em có viết đoạn code để lấy kết quả từ bảng Cân đối phát sinh qua bảng Cân đối kế toán, số chi tiết và Total 1 em đã code được, Total 2 em chưa đúng logic, nhờ Anh Chị hướng dẫn thêm giúp em 2 vấn đề sau:
1. Ô màu vàng là kết quả mong muốn với code chưa đúng logic ở Sub CDKT2()
2. Sub phụ là CDKT1() và CDKT2(), em đang dùng để tính tổng sau khi lấy số từ Sheets("CDPS") sang, nếu em lồng vào Sub chính là CDKT0() thì phải Run 2 lần mới có kết quả cuối cùng (Anh Chị gợi ý thêm giúp em đoạn này)

Em cảm ơn Anh Chị đã xem bài!

Code xử lý các ghi chú (*)
Kết quả để kế bên cho bạn dể kiểm tra

Sub XYZ()
  Dim aKT(), aPS(), a, res(), i&, j&, c&, dic As Object, t$, r&, d&
 
  Set dic = CreateObject("Scripting.Dictionary")
  With Sheets("CDKT")
    aKT = .Range("A9", .Cells(Rows.Count, "B").End(3)).Value
  End With
  ReDim res(1 To UBound(aKT), 1 To 2)
  For i = 1 To UBound(aKT)
    t = CStr(aKT(i, 2))
    If Right(t, 2) = "00" Then
      r = i
    ElseIf Right(t, 1) = "0" And t <> "420" Then
      d = i
    ElseIf Len(t) = 3 Then
      If Right(aKT(i, 1), 3) = "(*)" Then 'Tru tong so
        dic(t) = Array(i, -r, -d)
      Else
        dic(t) = Array(i, r, d)
      End If
    End If
  Next i

  With Sheets("CDPS")
    aPS = .Range("A12:J" & .Cells(Rows.Count, "D").End(3).Row).Value
  End With
  For i = 1 To UBound(aPS)
    For j = 1 To 2
      If dic.Exists(aPS(i, j)) Then
        a = dic(aPS(i, j))
        For c = 0 To 2
          r = Abs(a(c))
          d = Sgn(a(c))
          res(r, 1) = res(r, 1) + d * aPS(i, 8 + j)
          res(r, 2) = res(r, 2) + d * aPS(i, 4 + j)
        Next c
      End If
    Next j
  Next i
  For i = UBound(aKT) To 1 Step -1
    If Len(aKT(i, 2)) = 3 Then
      If InStr(1, "440270", aKT(i, 2)) Then r = i
      If InStr(1, "400300200100", aKT(i, 2)) Then
        res(r, 1) = res(i, 1) + res(r, 1)
        res(r, 2) = res(i, 2) + res(r, 2)
      End If
    End If
  Next i
  Sheets("CDKT").Range("F9").Resize(UBound(res), 2) = res
End Sub

 

[hieuvietmy2020]

Code xử lý các ghi chú (*)
Kết quả để kế bên cho bạn dể kiểm tra

Sub XYZ()
  Dim aKT(), aPS(), a, res(), i&, j&, c&, dic As Object, t$, r&, d&
 
  Set dic = CreateObject("Scripting.Dictionary")
  With Sheets("CDKT")
    aKT = .Range("A9", .Cells(Rows.Count, "B").End(3)).Value
  End With
  ReDim res(1 To UBound(aKT), 1 To 2)
  For i = 1 To UBound(aKT)
    t = CStr(aKT(i, 2))
    If Right(t, 2) = "00" Then
      r = i
    ElseIf Right(t, 1) = "0" And t <> "420" Then
      d = i
    ElseIf Len(t) = 3 Then
      If Right(aKT(i, 1), 3) = "(*)" Then 'Tru tong so
        dic(t) = Array(i, -r, -d)
      Else
        dic(t) = Array(i, r, d)
      End If
    End If
  Next i

  With Sheets("CDPS")
    aPS = .Range("A12:J" & .Cells(Rows.Count, "D").End(3).Row).Value
  End With
  For i = 1 To UBound(aPS)
    For j = 1 To 2
      If dic.Exists(aPS(i, j)) Then
        a = dic(aPS(i, j))
        For c = 0 To 2
          r = Abs(a(c))
          d = Sgn(a(c))
          res(r, 1) = res(r, 1) + d * aPS(i, 8 + j)
          res(r, 2) = res(r, 2) + d * aPS(i, 4 + j)
        Next c
      End If
    Next j
  Next i
  For i = UBound(aKT) To 1 Step -1
    If Len(aKT(i, 2)) = 3 Then
      If InStr(1, "440270", aKT(i, 2)) Then r = i
      If InStr(1, "400300200100", aKT(i, 2)) Then
        res(r, 1) = res(i, 1) + res(r, 1)
        res(r, 2) = res(i, 2) + res(r, 2)
      End If
    End If
  Next i
  Sheets("CDKT").Range("F9").Resize(UBound(res), 2) = res
End Sub

Em cảm ơn Anh @HieuCD , kết quả đúng rồi ạ,
Em đã và đang theo học các thuật code từ các bài viết của anh, rất chuyên nghiệp ạ!

 

[vak1590]

Theo tôi thì viết code cho CDPS là đúng;
Sheet CDKT thì chỉ cần Vlookup là Ok rồi.
Sheet CDKT thiếu mã số 138 nên Sum thiếu...

Đối với dữ liệu quá lớn thì code cho CDPS là hợp lý.
Còn CDKT chỉ nên dùng hàm là được rồi.