Điền dữ liệu có điều kiện

[BuiQuangThuan]

Chào các Thầy cô và anh chị.
Hiện tại em có bài toán muốn nhờ mọi người giúp.
Do chưa tìm ra được cách làm trong khi phải làm thủ công thấy cực quá.
Hiện tại kết quả mong muốn em đang điền bằng tay tại ô bôi màu xanh như hình đính kèm

Về cách giải thích em không biết nên giải thích sao cho dễ hiểu nữa

Xin giải thích thêm về cách làm hiện tại của em ạ: Hiện tại cùng 1 khách hàng từ 2 bảng.
Em sẽ lấy số tiền phát sinh có từ bảng 2 theo ngày sớm nhất để điền vào cột E của bảng 1 dựa theo ngày sớm nhất
Trường hợp không đủ thì sẽ lấy thêm "số phát sinh có" của ngày tiếp theo từ bảng 2
Nếu "số phát sinh có" còn dư sẽ được tính cho ngày tiếp theo của bảng 1 ạ


Mong thầy cô và mọi người giúp đỡ

 

[BuiQuangThuan]

dữ liệu 2 bảng phải theo thứ tự nghiệp vụ phát sinh thực tế

Dạ. vậy là trước khi chạy code. em sẽ phải sort lại dữ liệu ạ

Gởi file kết quả chạy không đúng lên, file gốc chạy bình thường

Em xin gửi lại file kết quả ko đúng ạ
Em cám ơn thầy nhiều ạ

 

[HieuCD]

dữ liệu 2 bảng phải theo thứ tự nghiệp vụ phát sinh thực tế
Gởi file kết quả chạy không đúng lên, file gốc chạy bình thường

Chỉnh lại

Option Explicit

Sub XYZ()
  Dim aHD(), aThu(), Res(), Dic As Object
  Dim srHD&, srThu&, i&, i2&, r&
  Dim S#, KH$, tmpDay, fRow&
 
  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("Sheet1")
    aHD = .Range("C3:D" & .Range("C" & Rows.Count).End(xlUp).Row).Value
    aThu = .Range("I3:L" & .Range("I" & Rows.Count).End(xlUp).Row).Value
  End With
  srHD = UBound(aHD): srThu = UBound(aThu)
  ReDim Res(1 To srHD, 1 To 2)
  For i = 1 To srHD
    KH = aHD(i, 1)
    If Dic.exists(KH) = False Then
      Dic.Add KH, ""
      fRow = 1
      For i2 = i To srHD
        If aHD(i2, 1) = KH Then
          S = aHD(i2, 2)
          For r = fRow To srThu
            If aThu(r, 3) = KH Then
              If Res(i2, 2) = Empty Then
                Res(i2, 2) = aThu(r, 1)
              ElseIf tmpDay <> aThu(r, 1) Then
                Res(i2, 2) = Res(i2, 2) & Chr(10) & aThu(r, 1)
              End If
              tmpDay = aThu(r, 1) 'Ngay nghiep vu truoc
              
              If aThu(r, 4) <= S Then
                Res(i2, 1) = Res(i2, 1) + aThu(r, 4)
                S = S - aThu(r, 4)
                fRow = r + 1
                If S = 0 Then Exit For
              Else
                aThu(r, 4) = aThu(r, 4) - S
                Res(i2, 1) = Res(i2, 1) + S
                fRow = r: Exit For
              End If
            End If
          Next r
        End If
      Next i2
    End If
  Next i
  Sheets("Sheet1").Range("E3").Resize(srHD, 2) = Res
End Sub

 

[BuiQuangThuan]

Chỉnh lại

Option Explicit

Sub XYZ()
  Dim aHD(), aThu(), Res(), Dic As Object
  Dim srHD&, srThu&, i&, i2&, r&
  Dim S#, KH$, tmpDay, fRow&

  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("Sheet1")
    aHD = .Range("C3:D" & .Range("C" & Rows.Count).End(xlUp).Row).Value
    aThu = .Range("I3:L" & .Range("I" & Rows.Count).End(xlUp).Row).Value
  End With
  srHD = UBound(aHD): srThu = UBound(aThu)
  ReDim Res(1 To srHD, 1 To 2)
  For i = 1 To srHD
    KH = aHD(i, 1)
    If Dic.exists(KH) = False Then
      Dic.Add KH, ""
      fRow = 1
      For i2 = i To srHD
        If aHD(i2, 1) = KH Then
          S = aHD(i2, 2)
          For r = fRow To srThu
            If aThu(r, 3) = KH Then
              If Res(i2, 2) = Empty Then
                Res(i2, 2) = aThu(r, 1)
              ElseIf tmpDay <> aThu(r, 1) Then
                Res(i2, 2) = Res(i2, 2) & Chr(10) & aThu(r, 1)
              End If
              tmpDay = aThu(r, 1) 'Ngay nghiep vu truoc
             
              If aThu(r, 4) <= S Then
                Res(i2, 1) = Res(i2, 1) + aThu(r, 4)
                S = S - aThu(r, 4)
                fRow = r + 1
                If S = 0 Then Exit For
              Else
                aThu(r, 4) = aThu(r, 4) - S
                Res(i2, 1) = Res(i2, 1) + S
                fRow = r: Exit For
              End If
            End If
          Next r
        End If
      Next i2
    End If
  Next i
  Sheets("Sheet1").Range("E3").Resize(srHD, 2) = Res
End Sub

Xin cám ơn thầy nhiều ạ.
Lần này có vẻ ra đúng kết quả em muốn rồi.