Tổng hợp công nợ theo Dự án/ hợp đồng/hạng mục công trình

[thaolg2610]

E mới tham gia diễn đàn. E có đọc hướng dẫn của các Anh: Bebo021999, Snow 25, Hieu CD về phần hỏi code VBA của bạn MinhHoai1963 đăng trong diễn đàn. E thấy các hướng dẫn của các Anh thật tuyệt vời và hữu ích với em. Nhân đây em cũng xin nhờ các Anh chị trong diễn đàn giúp em thêm về phần côd để tính công nợ chủ đầu từ phân theo từng dự án, từng hợp đồng và từng hạng mục công trình ( kèm theo file gửi kèm). E xin trân trọng cảm ơn sự hỗ trợ của các Anh chị!

 

[VetMini]

E với ấp khỉ mốc gì.
Với yêu cần này mà không thực hiện được bằng Pivot Table là do thiết kế bảng tính dỏm. Chỉ cần về học lại cách thiết kế bảng tính thôi.

 

[thaolg2610]

Thưa anh VetMini. Từ nhiều năm nay em đang dùng Pivot Table để theo dõi công nợ như file em đính kèm . Tuy nhiên em muốn chuyển sang dùng code VBA. Vì vậy em mới nhờ các anh chị trong diễn đàn giúp đỡ. Nếu anh không giúp được thì Anh cũng nên tôn trọng người khác. Cảm ơn anh cho em lời khuyên quý báu!

 

[HUONGHCKT]

Bạn nên sửa đổi tập tính viết tắt của mình.
Thử xem file với code VBA. Nhấn vào mặt cười để tận hưởng kết quả.
Hãy thử lại bằng cách thêm bớt hạy sửa lại dữ liệu.
Các vấn đề về định dạng, format bạn tự làm.
Nhớ báo lại kết quả chạy code.

 

[VetMini]

... Nếu anh không giúp được thì Anh cũng nên tôn trọng người khác. ...!

1. Tôi ít khi giúp những người cứng đầu. Người có tính hay tự ái thì đáng lẽ phải có tính tự lập. Có cốt kiếc thì cũng tự làm, và chỉ hỏi môt vài chỗ bị bí.
2. Tôi chủ yếu khuyên các bạn khác.
3. Ở đây ai cũng biết tôi có tính ngạo mạn và phách lối. Bạn là người thứ một ngàn mấy chục bảo tôi nên tôn trọng người khác. (tôi có quyền cứng đầu vì tôi có nhờ ai giải quyết vấn đề giùm mình đâu)

 

[thaolg2610]

Bạn nên sửa đổi tập tính viết tắt của mình.
Thử xem file với code VBA. Nhấn vào mặt cười để tận hưởng kết quả.
Hãy thử lại bằng cách thêm bớt hạy sửa lại dữ liệu.
Các vấn đề về định dạng, format bạn tự làm.
Nhớ báo lại kết quả chạy code.

E xin cảm ơn Anh HUONGHCKT. Kết quả rất chuẩn anh ạ. E đang tìm hiểu code của anh để áp dụng trong công việc của mình.

 

[BuiQuangThuan]

Các vấn đề về định dạng, format bạn tự làm.
Nhớ báo lại kết quả chạy code.

Chú code kì công thiệt ấy.

 

[HUONGHCKT]

Chú code kì công thiệt ấy.

Tôi đã mất hơn 1 ngày ngồi lỳ tại chỗ để code cho bạn ấy. tuy code có thể dài, thuật toan lòng vòng nhưng được cái là cuối cùng cũng ra được kết quả đúng.
Tôi còn có ý định làm luôn phần định dạng (=VBa) xong, nghĩ bạn đó có khi trình còn cao hơn mình nhiều nên thôi, vả lại cũng đã quá chán.

 

[HieuCD]

Thử cách dùng dic khác

Sub XYZ()
  Dim i&, j&, r&, n&, k&, ik&, ir&, iDA&, rowDA&, iHD&, rowHD&, stt&, key$
  Dim aDA(), aHD(), aHM(), arr(), aTong#(3 To 5), S, ST, res(), Dic As Object
 
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("DM CHUNG")
    aDA = .Range("A3", .Range("C1000000").End(xlUp)).Value
  End With
  With Sheets("DATA")
    arr = .Range("D4:M" & .Range("D1000000").End(xlUp).Row).Value
  End With
  ReDim res(1 To UBound(arr) * 3, 1 To 6)

  For i = 1 To UBound(arr)
    key = arr(i, 5) & "|" & arr(i, 3)
    If Dic.exists(key) = False Then Dic(arr(i, 5)) = Dic(arr(i, 5)) & "|" & arr(i, 3)
    Dic(key) = Dic(key) & "," & i
  Next i
  For i = 1 To UBound(aDA)
    If Dic.exists(aDA(i, 2)) Then
      k = k + 1:      iDA = iDA + 1
      rowDA = k:      iHD = 0
      res(k, 1) = Cells(1, iDA).Address(1, 0)
      res(k, 1) = Mid(res(k, 1), 1, InStr(1, res(k, 1), "$") - 1)
      res(k, 2) = aDA(i, 3)
      S = Split(Dic(aDA(i, 2)), "|")
      For r = 1 To UBound(S)
        k = k + 1:        iHD = iHD + 1
        rowHD = k:        stt = 0
        res(k, 1) = Application.Roman(iHD)
        ST = Split(Dic(aDA(i, 2) & "|" & S(r)), ",")
        res(k, 2) = arr(CLng(ST(1)), 4)
        For n = 1 To UBound(ST)
          ir = CLng(ST(n))
          key = aDA(i, 2) & "#" & arr(ir, 1)
          If Dic.exists(key) = False Then
            k = k + 1
            Dic.Add key, k
            stt = stt + 1
            res(k, 1) = stt
            res(k, 2) = arr(ir, 2)
            res(k, 6) = arr(ir, 10)
          End If
          ik = Dic(key)
          For j = 7 To 9
            res(ik, j - 4) = res(ik, j - 4) + arr(ir, j)
            res(rowDA, j - 4) = res(rowDA, j - 4) + arr(ir, j)
            res(rowHD, j - 4) = res(rowHD, j - 4) + arr(ir, j)
            aTong(j - 4) = aTong(j - 4) + arr(ir, j)
          Next j
        Next n
      Next r
    End If
  Next i
  res(k + 1, 2) = "T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng:"
  res(k + 1, 3) = aTong(3): res(k + 1, 4) = aTong(4): res(k + 1, 5) = aTong(5)
  Sheets("BAO CAO CONG NO").Range("A4:F10000").ClearContents
  Sheets("BAO CAO CONG NO").Range("A4").Resize(k + 1, 6) = res
End Sub

 

[thaolg2610]

Thử cách dùng dic khác

Sub XYZ()
  Dim i&, j&, r&, n&, k&, ik&, ir&, iDA&, rowDA&, iHD&, rowHD&, stt&, key$
  Dim aDA(), aHD(), aHM(), arr(), aTong#(3 To 5), S, ST, res(), Dic As Object
 
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("DM CHUNG")
    aDA = .Range("A3", .Range("C1000000").End(xlUp)).Value
  End With
  With Sheets("DATA")
    arr = .Range("D4:M" & .Range("D1000000").End(xlUp).Row).Value
  End With
  ReDim res(1 To UBound(arr) * 3, 1 To 6)

  For i = 1 To UBound(arr)
    key = arr(i, 5) & "|" & arr(i, 3)
    If Dic.exists(key) = False Then Dic(arr(i, 5)) = Dic(arr(i, 5)) & "|" & arr(i, 3)
    Dic(key) = Dic(key) & "," & i
  Next i
  For i = 1 To UBound(aDA)
    If Dic.exists(aDA(i, 2)) Then
      k = k + 1:      iDA = iDA + 1
      rowDA = k:      iHD = 0
      res(k, 1) = Cells(1, iDA).Address(1, 0)
      res(k, 1) = Mid(res(k, 1), 1, InStr(1, res(k, 1), "$") - 1)
      res(k, 2) = aDA(i, 3)
      S = Split(Dic(aDA(i, 2)), "|")
      For r = 1 To UBound(S)
        k = k + 1:        iHD = iHD + 1
        rowHD = k:        stt = 0
        res(k, 1) = Application.Roman(iHD)
        ST = Split(Dic(aDA(i, 2) & "|" & S(r)), ",")
        res(k, 2) = arr(CLng(ST(1)), 4)
        For n = 1 To UBound(ST)
          ir = CLng(ST(n))
          key = aDA(i, 2) & "#" & arr(ir, 1)
          If Dic.exists(key) = False Then
            k = k + 1
            Dic.Add key, k
            stt = stt + 1
            res(k, 1) = stt
            res(k, 2) = arr(ir, 2)
            res(k, 6) = arr(ir, 10)
          End If
          ik = Dic(key)
          For j = 7 To 9
            res(ik, j - 4) = res(ik, j - 4) + arr(ir, j)
            res(rowDA, j - 4) = res(rowDA, j - 4) + arr(ir, j)
            res(rowHD, j - 4) = res(rowHD, j - 4) + arr(ir, j)
            aTong(j - 4) = aTong(j - 4) + arr(ir, j)
          Next j
        Next n
      Next r
    End If
  Next i
  res(k + 1, 2) = "T" & ChrW(7893) & "ng c" & ChrW(7897) & "ng:"
  res(k + 1, 3) = aTong(3): res(k + 1, 4) = aTong(4): res(k + 1, 5) = aTong(5)
  Sheets("BAO CAO CONG NO").Range("A4:F10000").ClearContents
  Sheets("BAO CAO CONG NO").Range("A4").Resize(k + 1, 6) = res
End Sub

E rất cảm ơn Anh HieuCD đã giúp đỡ em. Đặc biệt code của anh giải quyết rất hiệu quả trong trường hợp mà 1 hợp đồng chỉ có duy nhất 1 hạng mục công trình. E cũng chúc các Anh trong Diễn đàn sức khỏe và thành công!