Ghép dữ liệu từ 2 bảng và tính số tồn còn lại thành dòng mới

Đình Phán · 25/11/23

Chào các anh, chị.

Em có bài toán về tính Chênh lệch tỷ giá, cụ thể em có 2 bảng dữ liệu
Bảng 1: Là chi tiết số công nợ gốc theo Hợp đồng của từng ngày hạch toán
Bảng 2: Là chi tiết số thanh toán theo từng hợp đồng của từng ngày thanh toán
Mục đích của em là tách các dòng công nợ gốc ở bảng 1 thành các dòng tương ứng với số tiền thanh toán của bảng 2, và số tồn còn lại của công nợ gốc.
Nó cũng tương tự như kiểu Nhập trước-Xuất trước (tức ưu tiên giảm cho dòng có ngày hạch toán xa về gần)
Mong anh, chị giúp đỡ ạ. Em cảm ơn!

Đình Phán · 26/11/23

Em thấy việc tách dòng công nợ gốc còn lại thành 1 dòng mới quá khó. Em nghĩ đến phương án là ghi số công nợ gốc còn lại ra 1 cột.
Bố trí sẽ như file đính kèm. Mong các anh, chị giúp đỡ hoặc cho em gợi ý ạ.

BuiQuangThuan · 26/11/23

Đình Phán đã viết:
Em thấy việc tách dòng công nợ gốc còn lại thành 1 dòng mới quá khó. Em nghĩ đến phương án là ghi số công nợ gốc còn lại ra 1 cột.
Bố trí sẽ như file đính kèm. Mong các anh, chị giúp đỡ hoặc cho em gợi ý ạ.

Chịu khó chờ 1 chút. Không phải là quá khó. Mà là bạn đang quá vội thôi

HieuCD · 26/11/23

Đình Phán đã viết:
Chào các anh, chị.

Em có bài toán về tính Chênh lệch tỷ giá, cụ thể em có 2 bảng dữ liệu
Bảng 1: Là chi tiết số công nợ gốc theo Hợp đồng của từng ngày hạch toán
Bảng 2: Là chi tiết số thanh toán theo từng hợp đồng của từng ngày thanh toán
Mục đích của em là tách các dòng công nợ gốc ở bảng 1 thành các dòng tương ứng với số tiền thanh toán của bảng 2, và số tồn còn lại của công nợ gốc.
Nó cũng tương tự như kiểu Nhập trước-Xuất trước (tức ưu tiên giảm cho dòng có ngày hạch toán xa về gần)
Mong anh, chị giúp đỡ ạ. Em cảm ơn!

Chưa bẩy lổi. Kiểm tra lại

Mã:

Option Explicit

Sub XYZ()
  Dim sh As Worksheet, dHD As Object, dTT As Object, a, b, aHD(), aTT(), res()
  Dim sHD&, sTT&, i&, r&, ia&, ib&, k&, fR&, j&
  Dim st#, t#, ngay As Date, key
 
  Set dHD = CreateObject("scripting.dictionary")
  Set dTT = CreateObject("scripting.dictionary")
  Set sh = ThisWorkbook.Sheets("Sheet1")
  aHD = sh.Range("A2", sh.Range("F1").End(xlDown)).Value
  aTT = sh.Range("I2", sh.Range("M1").End(xlDown)).Value
  sHD = UBound(aHD):      sTT = UBound(aTT)
  ReDim res(1 To sHD + sTT, 1 To 10)
  For i = 1 To sHD
    dHD(aHD(i, 1)) = dHD(aHD(i, 1)) & "," & i
  Next i
  For i = 1 To sTT
    dTT(aTT(i, 1)) = dTT(aTT(i, 1)) & "," & i
  Next i
  For Each key In dTT.keys
    dTT(key) = dTT(key) & "," & "Het"
    a = Split(dTT(key), ",")
    If dHD.exists(key) Then b = Split(dHD(key), ",") Else: b = Array("")
    fR = 1
    For i = 1 To UBound(a) - 1
      ia = CLng(a(i))
      ngay = aTT(ia, 2)
      st = -aTT(ia, 3)
      For r = fR To UBound(b)
        fR = r
        ib = CLng(b(r))
        If aHD(ib, 2) > ngay Then
          fR = UBound(b) + 1
          Exit For
        End If
        k = k + 1
        res(k, 1) = key:            res(k, 2) = aHD(ib, 2)
        res(k, 3) = aHD(ib, 3):     res(k, 5) = aHD(ib, 5)
        If st <= aHD(ib, 4) Then
          res(k, 4) = st
          st = 0
          aHD(ib, 4) = aHD(ib, 4) - res(k, 4)
        Else
          res(k, 4) = aHD(ib, 4)
          st = st - res(k, 4)
          aHD(ib, 4) = 0
          fR = r + 1
        End If
        res(k, 6) = res(k, 4) * res(k, 5)
        res(k, 7) = -res(k, 4):   res(k, 8) = aTT(ia, 4)
        res(k, 9) = res(k, 7) * res(k, 8): res(k, 10) = res(k, 6) + res(k, 9)
        If st = 0 Then Exit For
      Next r
      If a(i + 1) = "Het" Then
        For r = fR To UBound(b)
          k = k + 1
          ib = CLng(b(r))
          For j = 1 To 5
            res(k, j) = aHD(ib, j)
          Next j
          res(k, 6) = res(k, 4) * res(k, 5)
        Next r
      End If
    Next i
  Next key
  sh.Range("A20").Resize(UBound(res), 10) = res '****
End Sub

Đình Phán · 26/11/23

HieuCD đã viết:

Chưa bẩy lổi. Kiểm tra lại

Mã:

Option Explicit

Sub XYZ()
  Dim sh As Worksheet, dHD As Object, dTT As Object, a, b, aHD(), aTT(), res()
  Dim sHD&, sTT&, i&, r&, ia&, ib&, k&, fR&, j&
  Dim st#, t#, ngay As Date, key
 
  Set dHD = CreateObject("scripting.dictionary")
  Set dTT = CreateObject("scripting.dictionary")
  Set sh = ThisWorkbook.Sheets("Sheet1")
  aHD = sh.Range("A2", sh.Range("F1").End(xlDown)).Value
  aTT = sh.Range("I2", sh.Range("M1").End(xlDown)).Value
  sHD = UBound(aHD):      sTT = UBound(aTT)
  ReDim res(1 To sHD + sTT, 1 To 10)
  For i = 1 To sHD
    dHD(aHD(i, 1)) = dHD(aHD(i, 1)) & "," & i
  Next i
  For i = 1 To sTT
    dTT(aTT(i, 1)) = dTT(aTT(i, 1)) & "," & i
  Next i
  For Each key In dTT.keys
    dTT(key) = dTT(key) & "," & "Het"
    a = Split(dTT(key), ",")
    If dHD.exists(key) Then b = Split(dHD(key), ",") Else: b = Array("")
    fR = 1
    For i = 1 To UBound(a) - 1
      ia = CLng(a(i))
      ngay = aTT(ia, 2)
      st = -aTT(ia, 3)
      For r = fR To UBound(b)
        fR = r
        ib = CLng(b(r))
        If aHD(ib, 2) > ngay Then
          fR = UBound(b) + 1
          Exit For
        End If
        k = k + 1
        res(k, 1) = key:            res(k, 2) = aHD(ib, 2)
        res(k, 3) = aHD(ib, 3):     res(k, 5) = aHD(ib, 5)
        If st <= aHD(ib, 4) Then
          res(k, 4) = st
          st = 0
          aHD(ib, 4) = aHD(ib, 4) - res(k, 4)
        Else
          res(k, 4) = aHD(ib, 4)
          st = st - res(k, 4)
          aHD(ib, 4) = 0
          fR = r + 1
        End If
        res(k, 6) = res(k, 4) * res(k, 5)
        res(k, 7) = -res(k, 4):   res(k, 8) = aTT(ia, 4)
        res(k, 9) = res(k, 7) * res(k, 8): res(k, 10) = res(k, 6) + res(k, 9)
        If st = 0 Then Exit For
      Next r
      If a(i + 1) = "Het" Then
        For r = fR To UBound(b)
          k = k + 1
          ib = CLng(b(r))
          For j = 1 To 5
            res(k, j) = aHD(ib, j)
          Next j
          res(k, 6) = res(k, 4) * res(k, 5)
        Next r
      End If
    Next i
  Next key
  sh.Range("A20").Resize(UBound(res), 10) = res '****
End Sub

Em cảm ơn anh @HieuCD rất nhiều ạ. Em đã kiểm tra và code của anh đáp ứng hết các tình huống của em. Không rõ anh nói chưa bây lỗi là còn tình huống nào mà anh đang nghĩ đến ạ?

HieuCD · 26/11/23

Đình Phán đã viết:
Em cảm ơn anh @HieuCD rất nhiều ạ. Em đã kiểm tra và code của anh đáp ứng hết các tình huống của em. Không rõ anh nói chưa bây lỗi là còn tình huống nào mà anh đang nghĩ đến ạ?

Chưa xét các tình huống các hợp đồng 2 bảng không khớp nhau

Đình Phán · 26/11/23

HieuCD đã viết:
Chưa xét các tình huống các hợp đồng 2 bảng không khớp nhau

Anh có thể bổ sung giúp em là:
1. Nếu Hợp đồng có công nợ gốc ở bảng 1, không được thanh toán ở bảng 2 thì trả về nguyên trạng (từ cột A đến cột F của vùng kết quả)
2. Nếu Hợp đồng xuất hiện thanh toán ở bảng 2, nhưng không có ở bảng 1 thì chép dữ liệu từ đó vào cột A đến cột F vùng kết quả (hiểu là người bán trả tiền trước đó ạ, phần này số tiền vẫn là âm, em sẽ không đánh giá CLTG phần này, nhưng dữ liệu này có thể được đánh giá cho lần sau ạ).
Trong code của anh, em có thêm 1 cột ngày thanh toán nữa,
Em cảm ơn anh.

HieuCD · 27/11/23

Đình Phán đã viết:
Anh có thể bổ sung giúp em là:
1. Nếu Hợp đồng có công nợ gốc ở bảng 1, không được thanh toán ở bảng 2 thì trả về nguyên trạng (từ cột A đến cột F của vùng kết quả)
2. Nếu Hợp đồng xuất hiện thanh toán ở bảng 2, nhưng không có ở bảng 1 thì chép dữ liệu từ đó vào cột A đến cột F vùng kết quả (hiểu là người bán trả tiền trước đó ạ, phần này số tiền vẫn là âm, em sẽ không đánh giá CLTG phần này, nhưng dữ liệu này có thể được đánh giá cho lần sau ạ).
Trong code của anh, em có thêm 1 cột ngày thanh toán nữa,
Em cảm ơn anh.

Tại sao bảng 1 có số tiền âm?

Đình Phán · 27/11/23

HieuCD đã viết:
Tại sao bảng 1 có số tiền âm?

Số tiền âm là em giả định dữ liệu cũ có khoản người mua trả tiền trước anh ạ.
Hoặc bên bảng 2, nếu phát sinh thanh toán mà không có công nợ gốc thì cũng chính là khoản người mua trả tiền trước, nên sẽ bê nguyên trạng sang kết quả ạ.

HieuCD · 28/11/23

Đình Phán đã viết:
Số tiền âm là em giả định dữ liệu cũ có khoản người mua trả tiền trước anh ạ.
Hoặc bên bảng 2, nếu phát sinh thanh toán mà không có công nợ gốc thì cũng chính là khoản người mua trả tiền trước, nên sẽ bê nguyên trạng sang kết quả ạ.

Người mua trả tiền phải nhập bên bảng thanh toán, không thể nhập bên bảng bán ( giao hàng ). Dữ liệu không đúng chuẩn việc xử lý sẽ rất khó vì phải lường trước tất cả các khả năng có thể xảy ra.
Bạn cần nhập lại dữ liệu với tất cả khả năng có thể xảy ra và nhập tay chính xác kết quả

Ghép dữ liệu từ 2 bảng và tính số tồn còn lại thành dòng mới

Đình Phán

Thành viên thường trực

File đính kèm

Đình Phán

Thành viên thường trực

File đính kèm

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

HieuCD

Chuyên gia GPE

Đình Phán

Thành viên thường trực

HieuCD

Chuyên gia GPE

Đình Phán

Thành viên thường trực

File đính kèm

HieuCD

Chuyên gia GPE

Đình Phán

Thành viên thường trực

HieuCD

Chuyên gia GPE

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

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng