Tính tổng số giờ công theo từng nhóm phép

Masu1991 · 13/10/23

Chào Anh Chị và các Bạn,

MÌnh có 1 file với dữ liệu tương đối lớn, xin nhờ anh chị giúp đỡ lấy dữ liệu với các tiêu chí:

Tính tổng theo mã số thẻ cho các cột sau:
+ số ngày công yêu cầu (G): tính tổng cột AA ở sheet data
+ số giờ công thực tế(H): Tính tổng cột AB ở sheet data
+ số giờ tăng ca (O): Tính tổng cột AO ở sheet data

Tính tổng các nhóm phép theo mã số thẻ và loại phép theo nhóm phép tương ứng

Phép năm
Phép việc riêng
Phép bệnh
Phép khác
Không phép
Phép hưởng lương

Ví dụ:
cột AJ (sheet data ) có dữ liệu là: VN-PN(8)-07:45~16:45 thì: cột PHÉP NĂM (sheet t1) sẽ là 8. (tức là lấy sô trong dấu ngoặc tương ứng VN-PN)

cột AJ (sheet data ) có dữ liệu là: VN-FH2(4)-14:00~18:00,VN-RP(4)-18:00~22:00 thì kết quả cột PHÉP NĂM (sheet t1) sẽ là 4 và cột PHÉP VIỆC riêng (sheet t1) sẽ là 4

Xin cảm ơn
Anh Chị và các Bạn đã hỗ trợ ạ

HUONGHCKT · 13/10/23

Masu1991 đã viết:
Chào Anh Chị và các Bạn,

MÌnh có 1 file với dữ liệu tương đối lớn, xin nhờ anh chị giúp đỡ lấy dữ liệu với các tiêu chí:

Tính tổng theo mã số thẻ cho các cột sau:
+ số ngày công yêu cầu (G): tính tổng cột AA ở sheet data
+ số giờ công thực tế(H): Tính tổng cột AB ở sheet data
+ số giờ tăng ca (O): Tính tổng cột AO ở sheet data

Tính tổng các nhóm phép theo mã số thẻ và loại phép theo nhóm phép tương ứng

Phép năm

Phép việc riêng

Phép bệnh

Phép khác

Không phép

Phép hưởng lương

Ví dụ:
cột AJ (sheet data ) có dữ liệu là: VN-PN(8)-07:45~16:45 thì: cột PHÉP NĂM (sheet t1) sẽ là 8. (tức là lấy sô trong dấu ngoặc tương ứng VN-PN)

cột AJ (sheet data ) có dữ liệu là: VN-FH2(4)-14:00~18:00,VN-RP(4)-18:00~22:00 thì kết quả cột PHÉP NĂM (sheet t1) sẽ là 4 và cột PHÉP VIỆC riêng (sheet t1) sẽ là 4

Xin cảm ơn
Anh Chị và các Bạn đã hỗ trợ ạ

Trong khi chờ các giải pháp khác hãy thử xem code này xem sao.

Mã:

Option Explicit

Sub MaSu()
Dim i&, j&, Lr&, t&, k&, v1&, v2&, P&
Dim Arr(), ArrF(), KQ(), S, F As String
Dim Dic As Object, DicF As Object, Key, Tmp, Temp
Dim Ws As Worksheet, Sh As Worksheet
Set Ws = Sheets("t1")
ArrF = Ws.Range("T2:V24").Value
Set DicF = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(ArrF)
    Temp = Split(ArrF(i, 1), "-")
    If Not DicF.exists(Temp(1)) Then DicF.Add (Temp(1)), ArrF(i, 3)
Next i
Set Sh = Sheets("data")
Lr = Sh.Cells(Rows.Count, 9).End(xlUp).Row
Arr = Sh.Range("A3:AO" & Lr).Value

Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To UBound(Arr), 1 To 15)
For i = 1 To UBound(Arr)
    Key = Arr(i, 9)
        If Not Dic.exists(Key) Then
            t = t + 1: Dic.Add (Key), t
            KQ(t, 1) = Arr(i, 4)
            KQ(t, 2) = Arr(i, 5)
            KQ(t, 4) = Arr(i, 13)
            KQ(t, 5) = Arr(i, 9)
            KQ(t, 6) = Arr(i, 10)
            KQ(t, 7) = Arr(i, 27)
            KQ(t, 8) = Arr(i, 28)
            KQ(t, 15) = Arr(i, 41)
            If Arr(i, 36) <> Empty Then
                S = Split(Arr(i, 36), ",")
                For j = 0 To UBound(S)
                    Tmp = Split(S(j), "-")
                    v1 = InStr(1, Tmp(1), "("): v2 = InStr(1, Tmp(1), ")")
                    P = -1 * Mid(Tmp(1), v1, 1 + v2 - v1)
                    F = Mid(Tmp(1), 1, v1 - 1)
                    If DicF.exists(F) Then
                        Col = DicF.Item(F): KQ(t, Col) = P
                    End If
                Next j
            End If
        Else
            k = Dic.Item(Key)
            KQ(k, 7) = KQ(k, 7) + Arr(i, 27)
            KQ(k, 8) = KQ(k, 8) + Arr(i, 28)
            KQ(k, 14) = KQ(k, 14) + Arr(i, 41)
            If Arr(i, 36) <> Empty Then
                S = Split(Arr(i, 36), ",")
                For j = 0 To UBound(S)
                    Tmp = Split(S(j), "-")
                    v1 = InStr(1, Tmp(1), "("): v2 = InStr(1, Tmp(1), ")")
                    P = -1 * Mid(Tmp(1), v1, 1 + v2 - v1)
                    F = Mid(Tmp(1), 1, v1 - 1)
                    If DicF.exists(F) Then
                        Col = DicF.Item(F): KQ(k, Col) = KQ(k, Col) + P
                    End If
                Next j
            End If
        End If
Next i

If t Then
    Ws.Range("A70").Resize(10000, 15).ClearContents
    Ws.Range("A70").Resize(t, 15) = KQ
End If
Set Dic = Nothing
MsgBox "Xong"
End Sub

Nhấn nút chạy Code để được kết quả ở A70.....

Maika8008 · 14/10/23

HUONGHCKT đã viết:

Trong khi chờ các giải pháp khác hãy thử xem code này xem sao.

Mã:

Option Explicit

Sub MaSu()
Dim i&, j&, Lr&, t&, k&, v1&, v2&, P&
Dim Arr(), ArrF(), KQ(), S, F As String
Dim Dic As Object, DicF As Object, Key, Tmp, Temp
Dim Ws As Worksheet, Sh As Worksheet
Set Ws = Sheets("t1")
ArrF = Ws.Range("T2:V24").Value
Set DicF = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(ArrF)
    Temp = Split(ArrF(i, 1), "-")
    If Not DicF.exists(Temp(1)) Then DicF.Add (Temp(1)), ArrF(i, 3)
Next i
Set Sh = Sheets("data")
Lr = Sh.Cells(Rows.Count, 9).End(xlUp).Row
Arr = Sh.Range("A3:AO" & Lr).Value

Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To UBound(Arr), 1 To 15)
For i = 1 To UBound(Arr)
    Key = Arr(i, 9)
        If Not Dic.exists(Key) Then
            t = t + 1: Dic.Add (Key), t
            KQ(t, 1) = Arr(i, 4)
            KQ(t, 2) = Arr(i, 5)
            KQ(t, 4) = Arr(i, 13)
            KQ(t, 5) = Arr(i, 9)
            KQ(t, 6) = Arr(i, 10)
            KQ(t, 7) = Arr(i, 27)
            KQ(t, 8) = Arr(i, 28)
            KQ(t, 15) = Arr(i, 41)
            If Arr(i, 36) <> Empty Then
                S = Split(Arr(i, 36), ",")
                For j = 0 To UBound(S)
                    Tmp = Split(S(j), "-")
                    v1 = InStr(1, Tmp(1), "("): v2 = InStr(1, Tmp(1), ")")
                    P = -1 * Mid(Tmp(1), v1, 1 + v2 - v1)
                    F = Mid(Tmp(1), 1, v1 - 1)
                    If DicF.exists(F) Then
                        Col = DicF.Item(F): KQ(t, Col) = P
                    End If
                Next j
            End If
        Else
            k = Dic.Item(Key)
            KQ(k, 7) = KQ(k, 7) + Arr(i, 27)
            KQ(k, 8) = KQ(k, 8) + Arr(i, 28)
            KQ(k, 14) = KQ(k, 14) + Arr(i, 41)
            If Arr(i, 36) <> Empty Then
                S = Split(Arr(i, 36), ",")
                For j = 0 To UBound(S)
                    Tmp = Split(S(j), "-")
                    v1 = InStr(1, Tmp(1), "("): v2 = InStr(1, Tmp(1), ")")
                    P = -1 * Mid(Tmp(1), v1, 1 + v2 - v1)
                    F = Mid(Tmp(1), 1, v1 - 1)
                    If DicF.exists(F) Then
                        Col = DicF.Item(F): KQ(k, Col) = KQ(k, Col) + P
                    End If
                Next j
            End If
        End If
Next i

If t Then
    Ws.Range("A70").Resize(10000, 15).ClearContents
    Ws.Range("A70").Resize(t, 15) = KQ
End If
Set Dic = Nothing
MsgBox "Xong"
End Sub

Nhấn nút chạy Code để được kết quả ở A70.....

Bạn @HUONGHCKT phong độ vẫn ổn định nhỉ

HUONGHCKT · 14/10/23

Maika8008 đã viết:
Bạn @HUONGHCKT phong độ vẫn ổn định nhỉ

Cảm ơn anh đã xem bài và động viên. Chúc anh vui, khỏe, hạnh phúc và có nhiều niềm vui.

Masu1991 · 14/10/23

HUONGHCKT đã viết:

Trong khi chờ các giải pháp khác hãy thử xem code này xem sao.

Mã:

Option Explicit

Sub MaSu()
Dim i&, j&, Lr&, t&, k&, v1&, v2&, P&
Dim Arr(), ArrF(), KQ(), S, F As String
Dim Dic As Object, DicF As Object, Key, Tmp, Temp
Dim Ws As Worksheet, Sh As Worksheet
Set Ws = Sheets("t1")
ArrF = Ws.Range("T2:V24").Value
Set DicF = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(ArrF)
    Temp = Split(ArrF(i, 1), "-")
    If Not DicF.exists(Temp(1)) Then DicF.Add (Temp(1)), ArrF(i, 3)
Next i
Set Sh = Sheets("data")
Lr = Sh.Cells(Rows.Count, 9).End(xlUp).Row
Arr = Sh.Range("A3:AO" & Lr).Value

Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To UBound(Arr), 1 To 15)
For i = 1 To UBound(Arr)
    Key = Arr(i, 9)
        If Not Dic.exists(Key) Then
            t = t + 1: Dic.Add (Key), t
            KQ(t, 1) = Arr(i, 4)
            KQ(t, 2) = Arr(i, 5)
            KQ(t, 4) = Arr(i, 13)
            KQ(t, 5) = Arr(i, 9)
            KQ(t, 6) = Arr(i, 10)
            KQ(t, 7) = Arr(i, 27)
            KQ(t, 8) = Arr(i, 28)
            KQ(t, 15) = Arr(i, 41)
            If Arr(i, 36) <> Empty Then
                S = Split(Arr(i, 36), ",")
                For j = 0 To UBound(S)
                    Tmp = Split(S(j), "-")
                    v1 = InStr(1, Tmp(1), "("): v2 = InStr(1, Tmp(1), ")")
                    P = -1 * Mid(Tmp(1), v1, 1 + v2 - v1)
                    F = Mid(Tmp(1), 1, v1 - 1)
                    If DicF.exists(F) Then
                        Col = DicF.Item(F): KQ(t, Col) = P
                    End If
                Next j
            End If
        Else
            k = Dic.Item(Key)
            KQ(k, 7) = KQ(k, 7) + Arr(i, 27)
            KQ(k, 8) = KQ(k, 8) + Arr(i, 28)
            KQ(k, 14) = KQ(k, 14) + Arr(i, 41)
            If Arr(i, 36) <> Empty Then
                S = Split(Arr(i, 36), ",")
                For j = 0 To UBound(S)
                    Tmp = Split(S(j), "-")
                    v1 = InStr(1, Tmp(1), "("): v2 = InStr(1, Tmp(1), ")")
                    P = -1 * Mid(Tmp(1), v1, 1 + v2 - v1)
                    F = Mid(Tmp(1), 1, v1 - 1)
                    If DicF.exists(F) Then
                        Col = DicF.Item(F): KQ(k, Col) = KQ(k, Col) + P
                    End If
                Next j
            End If
        End If
Next i

If t Then
    Ws.Range("A70").Resize(10000, 15).ClearContents
    Ws.Range("A70").Resize(t, 15) = KQ
End If
Set Dic = Nothing
MsgBox "Xong"
End Sub

Nhấn nút chạy Code để được kết quả ở A70.....

Cảm ơn anh rất nhiều ạ.

Tính tổng số giờ công theo từng nhóm phép

Masu1991

Thành viên hoạt động

File đính kèm

HUONGHCKT

Zalo 0986997214

File đính kèm

Maika8008

Thành viên gạo cội

HUONGHCKT

Zalo 0986997214

Masu1991

Thành viên hoạt động

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

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