Nhờ trợ giúp code phân bổ theo điều kiện (dạng a1=d/(a+b)*a)

[Binbo2020]

Nhờ mọi người trên GPE xem giúp mình với:
Khóa của mình ở đây là: ngày, tháng, năm, ca, số xe
Một số xe trong một ca có số tổng tiêu thụ của các công việc
Số kế hoạch thì chi tiết cho các công việc trong ca
Mình muốn phân bổ số tiêu thụ cho các công việc theo số kế hoạch.
VD: xe số 1 trong ngày 1/9/2017 có tổng số tiêu thụ = 100
Số kế hoạch trong công việc A là 40, công việc B là 50.
Phân bổ lại số tiêu thụ theo
+ Công việc A = 100/(40+50)*40 = 44,4
+ Công việc B = 100/(40+50)*50 = 55,6
Chi tiết trong file mình đính kèm, nhờ mọi người xem giúp với

 

[befaint]

Phân bổ

 

[Binbo2020]

Cám ơn bạn nhiều. Cám ơn cả góp ý của bạn trong file nữa.
Nhưng ngày tháng tách như thế là để tiện cho các việc khác nữa.
Mình đang nhập liệu bằng form VBA trong excel, nên khi dùng công thức thì lúc nhập liệu bị chậm do vừa nhập vừa tự chạy tham chiếu.
Dù sao cũng cám ơn bạn nhiều

 

[befaint]

Cám ơn bạn nhiều. Cám ơn cả góp ý của bạn trong file nữa.
Nhưng ngày tháng tách như thế là để tiện cho các việc khác nữa.
Mình đang nhập liệu bằng form VBA trong excel, nên khi dùng công thức thì lúc nhập liệu bị chậm do vừa nhập vừa tự chạy tham chiếu.
Dù sao cũng cám ơn bạn nhiều

 

[Binbo2020]

Bạn ơi xem lại giúp mình chút, khi mình thử thay đổi thời gian và xe không sắp xếp theo trình tự thì kết quả trả ra không đúng

 

[Binbo2020]

Mình dựa vào code của bạn befaint và thử điều chỉnh một chút và thấy chạy được.
Có bạn nào xem giúp hộ mình xem còn lỗi gì mà mình không nhận ra hay không

Sub Phan_Bo1()
    Dim a(), lRow As Long, sMatch As String, eMatch As String
    Dim Res(), TT As Double, KH As Double, i As Long, j As Long
    
    With Sheet5
        lRow = .Range("A" & Rows.Count).End(xlUp).Row
        a = .Range("A7:S" & lRow).Value
        lRow = UBound(a, 1)
        ReDim Res(1 To lRow, 1 To 1)
        For i = 1 To lRow
          
            sMatch = a(i, 1) & "#" & a(i, 2) & "#" & a(i, 3) & "#" & a(i, 4) & "#" & a(i, 5)
            TT = 0: KH = 0
            'Xac dinh so Tieu_thu
            For j = 1 To lRow
                eMatch = a(j, 1) & "#" & a(j, 2) & "#" & a(j, 3) & "#" & a(j, 4) & "#" & a(j, 5)
                If sMatch = eMatch Then TT = TT + a(j, 18)
              
            Next j
            'Xac dinh so Ke_hoach
            For j = 1 To lRow
                eMatch = a(j, 1) & "#" & a(j, 2) & "#" & a(j, 3) & "#" & a(j, 4) & "#" & a(j, 5)
                If sMatch = eMatch Then KH = KH + a(j, 19)
              
            Next j
            'Tinh Phan_bo
            Res(i, 1) = a(i, 19) * TT / KH
        Next i
        .Range("U7").ClearContents
        .Range("U7").Resize(lRow, 1) = Res
    End With
End Sub