TỔNG HỢP LƯƠNG BẰNG CONSOLIDATE NHƯNG KHÔNG TỔNG HỢP ĐƯỢC HỌ TÊN (3 người xem)

[Chau240492]

Chào cả nhà,
Hiện tại e đang tổng hợp lương để quyết toán , e dùng consolidate để tổng hợp các sheet thành sheet tổng hợp
Nhưng ở sheet tổng hợp chỉ có các dữ liệu là được tổng hợp , còn họ tên hay là bộ phận thì không hiển thị ra
M.n xem giúp em coi em có làm sai chỗ nào không ạ
em có gửi kèm ví dụ ạ

 

[dongdaehyo_192]

Chào cả nhà,
Hiện tại e đang tổng hợp lương để quyết toán , e dùng consolidate để tổng hợp các sheet thành sheet tổng hợp
Nhưng ở sheet tổng hợp chỉ có các dữ liệu là được tổng hợp , còn họ tên hay là bộ phận thì không hiển thị ra
M.n xem giúp em coi em có làm sai chỗ nào không ạ
em có gửi kèm ví dụ ạ

Theo em thì bác nên Vlookup phần MSNV, Bộ phận... riêng

 

[Chau240492]

Theo em thì bác nên Vlookup phần MSNV, Bộ phận... riêng

Theo em thì bác nên Vlookup phần MSNV, Bộ phận... riêng

vậy ạ, hix, lại mất thời gian rồi đây. huhu

 

[vanaccex]

vậy ạ, hix, lại mất thời gian rồi đây. huhu

Nếu không thì sử dụng VBA

Sub CongTong()
Dim Dic As Object, Ws As Worksheet, ArrDuLieu, KetQua
Dim I As Long, K As Long, CoL As Long, Tem As String
ReDim KetQua(1 To 65000, 1 To 4)
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.CodeName <> "Sheet5" Then
        ArrDuLieu = Ws.Range(Ws.[A2], Ws.[B65000].End(3)).Resize(, 4).Value
        For I = 1 To UBound(ArrDuLieu)
            Tem = UCase(ArrDuLieu(I, 1)) & "#" & UCase(ArrDuLieu(I, 2)) & "#" & UCase(ArrDuLieu(I, 3))
            If Not Dic.Exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                    KetQua(K, 1) = ArrDuLieu(I, 1)
                    KetQua(K, 2) = ArrDuLieu(I, 2)
                    KetQua(K, 3) = ArrDuLieu(I, 3)
                    KetQua(K, 4) = ArrDuLieu(I, 4)
                Else
                    KetQua(Dic.Item(Tem), 4) = KetQua(Dic.Item(Tem), 4) + ArrDuLieu(I, 4)
            End If
        Next I
    End If
Next Ws
With Sheet5
    .[B3:E65000].ClearContents
    .[B3].Resize(K, 4) = KetQua
End With
Set Dic = Nothing
End Sub

 

[Chau240492]

Nếu không thì sử dụng VBA

Sub CongTong()
Dim Dic As Object, Ws As Worksheet, ArrDuLieu, KetQua
Dim I As Long, K As Long, CoL As Long, Tem As String
ReDim KetQua(1 To 65000, 1 To 4)
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.CodeName <> "Sheet5" Then
        ArrDuLieu = Ws.Range(Ws.[A2], Ws.[B65000].End(3)).Resize(, 4).Value
        For I = 1 To UBound(ArrDuLieu)
            Tem = UCase(ArrDuLieu(I, 1)) & "#" & UCase(ArrDuLieu(I, 2)) & "#" & UCase(ArrDuLieu(I, 3))
            If Not Dic.Exists(Tem) Then
                K = K + 1
                Dic.Add Tem, K
                    KetQua(K, 1) = ArrDuLieu(I, 1)
                    KetQua(K, 2) = ArrDuLieu(I, 2)
                    KetQua(K, 3) = ArrDuLieu(I, 3)
                    KetQua(K, 4) = ArrDuLieu(I, 4)
                Else
                    KetQua(Dic.Item(Tem), 4) = KetQua(Dic.Item(Tem), 4) + ArrDuLieu(I, 4)
            End If
        Next I
    End If
Next Ws
With Sheet5
    .[B3:E65000].ClearContents
    .[B3].Resize(K, 4) = KetQua
End With
Set Dic = Nothing
End Sub

để mình làm thử xem sao, cám ơn bạn

 

[vanaccex]

để mình làm thử xem sao, cám ơn bạn

Bạn xem file đính kèm ở trên mình vừa cho vào !