Cần giúp tính toán Tổng giờ thực hiện theo từng người

[giang127]

Chào các bác,
Nhờ bác nào có kinh nghiệm giúp đỡ em công thức tính Tổng giờ thực hiện theo từng người. Hiện có việc nhiều người cùng làm, tính theo tỷ lệ thì sẽ khác. Chi tiết theo như file đính kèm ạ.

 

[snow25]

Chào các bác,
Nhờ bác nào có kinh nghiệm giúp đỡ em công thức tính Tổng giờ thực hiện theo từng người. Hiện có việc nhiều người cùng làm, tính theo tỷ lệ thì sẽ khác. Chi tiết theo như file đính kèm ạ.

Thử code.

Sub ghjk()
    Dim i As Long, lr As Long, arr, kq, dic, j As Integer, a As Long, dk As String, b As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 2 Then GoTo xong
         arr = .Range("C2:O" & lr).Value
         ReDim kq(1 To UBound(arr) * 4, 1 To 2)
         For i = 1 To UBound(arr)
             For j = 1 To 12 Step 2
                 dk = arr(i, j)
                 If Len(dk) Then
                 If Not dic.exists(dk) Then
                    a = a + 1
                    dic.Add dk, a
                    kq(a, 1) = dk
                    kq(a, 2) = arr(i, j + 1) * arr(i, 13)
                Else
                   b = dic.Item(dk)
                   kq(b, 2) = kq(b, 2) + arr(i, j + 1) * arr(i, 13)
                End If
                End If
             Next j
        Next i
        .Range("q2:R1000").ClearContents
        If a Then .Range("q2:r2").Resize(a).Value = kq
    End With
xong:
    Set dic = Nothing
End Sub

 

[giang127]

Thử code.

Sub ghjk()
    Dim i As Long, lr As Long, arr, kq, dic, j As Integer, a As Long, dk As String, b As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 2 Then GoTo xong
         arr = .Range("C2:O" & lr).Value
         ReDim kq(1 To UBound(arr) * 4, 1 To 2)
         For i = 1 To UBound(arr)
             For j = 1 To 12 Step 2
                 dk = arr(i, j)
                 If Len(dk) Then
                 If Not dic.exists(dk) Then
                    a = a + 1
                    dic.Add dk, a
                    kq(a, 1) = dk
                    kq(a, 2) = arr(i, j + 1) * arr(i, 13)
                Else
                   b = dic.Item(dk)
                   kq(b, 2) = kq(b, 2) + arr(i, j + 1) * arr(i, 13)
                End If
                End If
             Next j
        Next i
        .Range("q2:R1000").ClearContents
        If a Then .Range("q2:r2").Resize(a).Value = kq
    End With
xong:
    Set dic = Nothing
End Sub

Rất cảm ơn bác đã giúp đỡ bằng Hàm VBA. Nhưng case của mình có thể xử lý bằng công thức không nhỉ. Mình cũng muốn học hỏi thêm về công thức excel. Hơn nữa gửi file có VBA máy cơ quan nó toàn báo virus

 

[CHAOQUAY]

Chào các bác,
Nhờ bác nào có kinh nghiệm giúp đỡ em công thức tính Tổng giờ thực hiện theo từng người. Hiện có việc nhiều người cùng làm, tính theo tỷ lệ thì sẽ khác. Chi tiết theo như file đính kèm ạ.

Công thức mảng, kết thúc = ctrl+shift+enter.
Tại R2

=SUM(IF($C$2:$M$7=Q2,$D$2:$N$7*$O$2:$O$7,0))

 

[giang127]

Công thức mảng, kết thúc = ctrl+shift+enter.
Tại R2

=SUM(IF($C$2:$M$7=Q2,$D$2:$N$7*$O$2:$O$7,0))

Mình làm được rồi, cảm ơn bạn nhiều nha