TỔNG HỢP LƯƠNG BẰNG CONSOLIDATE NHƯNG KHÔNG TỔNG HỢP ĐƯỢC HỌ TÊN

Liên hệ QC

Chau240492

Thành viên mới
Tham gia
17/11/18
Bài viết
26
Được thích
1
Giới tính
Nam
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ụ ạ
 

File đính kèm

  • CONSOLIDATE.xlsx
    11.4 KB · Đọc: 25
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
 
vậy ạ, hix, lại mất thời gian rồi đây. huhu
Nếu không thì sử dụng VBA
Mã:
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
 

File đính kèm

  • CONSOLIDATE (1).xlsm
    21.8 KB · Đọc: 6
Lần chỉnh sửa cuối:
Nếu không thì sử dụng VBA
Mã:
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
 
Web KT
Back
Top Bottom