Tổng hơp các sheet chi tiết sang sheet tổng hợp dựa vào mã số (1 người xem)

Elx Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Excel365

Excel365

Thành viên tích cực
Tham gia
29/10/10
Bài viết
865
Được thích
127
Giới tính
Nam
Nhờ các anh chị giúp em viết code tổng hợp các bảng lương chi tiết sang bảng tổng hợp cả năm dựa vào mã số từng người.
Hàng tháng có phát inh người mới, do vậy khi cần tổng hợp thì người mới cũng sẽ cập nhật bên Bảng TH.
Chức danh sẽ lấy chức danh ở tháng lớn nhất (ví dụ: tháng 1 ông A chức danh là nhân viên, nhưng sang tháng 10 ông A lên có chức danh là phó phong thì bên bảng tổng hợp sẽ tự cập nhật thành chức danh phó phòng.
Rất mong được anh chị giúp đỡ.
Trân trọng cảm ơn
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
huuduy.duy đã viết:
Nhờ các anh chị giúp em viết code tổng hợp các bảng lương chi tiết sang bảng tổng hợp cả năm dựa vào mã số từng người.
Hàng tháng có phát inh người mới, do vậy khi cần tổng hợp thì người mới cũng sẽ cập nhật bên Bảng TH.
Chức danh sẽ lấy chức danh ở tháng lớn nhất (ví dụ: tháng 1 ông A chức danh là nhân viên, nhưng sang tháng 10 ông A lên có chức danh là phó phong thì bên bảng tổng hợp sẽ tự cập nhật thành chức danh phó phòng.
Rất mong được anh chị giúp đỡ.
Trân trọng cảm ơn
Nhấp chuột vào đây để mở rộng...

Excel mà xài biểu bảng như Word chắc oải luôn.
Nếu chịu thêm 1 cột C (Nhóm) của từng người và 2 cột phụ AE:AF trong sheet TH thì xem file này.
Nếu không chịu thì "chạy"
 

File đính kèm

Upvote 0
Ba Tê đã viết:
Excel mà xài biểu bảng như Word chắc oải luôn.
Nếu chịu thêm 1 cột C (Nhóm) của từng người và 2 cột phụ AE:AF trong sheet TH thì xem file này.
Nếu không chịu thì "chạy"
Nhấp chuột vào đây để mở rộng...
Dạ cám ơn anh. Như vây thì các sheet chi tiết cột phụ C phải làm thủ công hả anh.
Còn 2 cột AE:AF thì sử dụng như thế nào vậy anh. Có phải trong tháng cần tổng hợp bộ phận nào thì điền tên bộ phận đó vô đúng không anh
Trân trọng
 
Upvote 0
huuduy.duy đã viết:
1/ Như vây thì các sheet chi tiết cột phụ C phải làm thủ công hả anh.
2/ Còn 2 cột AE:AF thì sử dụng như thế nào vậy anh. Có phải trong tháng cần tổng hợp bộ phận nào thì điền tên bộ phận đó vô đúng không anh
Nhấp chuột vào đây để mở rộng...
1/ Cột phụ C và 2 cột AE:AF bắt buộc phải có, thủ công hay công thức, hay gì đó thì tùy bạn.
2/ Cột AE là tên các tháng, cột AF là tên các nhóm cần tổng hợp, bạn cứ vọc "từa lưa" sẽ biết thôi mà.
 
Upvote 0
Ba Tê đã viết:
1/ Cột phụ C và 2 cột AE:AF bắt buộc phải có, thủ công hay công thức, hay gì đó thì tùy bạn.
2/ Cột AE là tên các tháng, cột AF là tên các nhóm cần tổng hợp, bạn cứ vọc "từa lưa" sẽ biết thôi mà.
Nhấp chuột vào đây để mở rộng...
Anh xem dùm em công thức ở cột C em làm như vậy có được chưa
=IF(AND(D10<>"";G10="");D10;IF(G10<>"";C9;D10)).
Em xin lỗi làm phiên anh thêm lần nữa, anh có thể làm thêm dòng tổng công tùng bộ phận, và tổng cộng cuối cung được không anh.
P/s: Nếu anh thấy rắc rối thì không làm cũng được ạ. em tự tinh bằng công thức
 
Lần chỉnh sửa cuối:
Upvote 0
huuduy.duy đã viết:
Anh xem dùm em công thức ở cột C em làm như vậy có được chưa
=IF(AND(D10<>"";G10="");D10;IF(G10<>"";C9;D10)).
Em xin lỗi làm phiên anh thêm lần nữa, anh có thể làm thêm dòng tổng công tùng bộ phận, và tổng cộng cuối cung được không anh.
P/s: Nếu anh thấy rắc rối thì không làm cũng được ạ. em tự tinh bằng công thức
Nhấp chuột vào đây để mở rộng...

Bạn nhập vào ô AF4="TỔNG CỘNG:"
Thay Sub cũ bằng cái này, rồi tự kiểm tra kết quả xem có đúng không nhé.
PHP: 
Public Sub TongHop()
Dim Dic As Object, Sh(), Nhom(), Tong(1 To 1, 1 To 20), N As Long, M As Long, I As Long, J As Long, K As Long, R As Long
Dim sArr(), dArr(1 To 1000, 1 To 28), Tem As String, ShName As String, STT As Long, X As Long
Set Dic = CreateObject("Scripting.Dictionary")
Sh = Range([AE6], [AE6].End(xlDown)).Value
Nhom = Range([AF6], [AF6].End(xlDown)).Value
For N = 1 To UBound(Nhom, 1)
    K = K + 1: R = K
    dArr(K, 4) = Nhom(N, 1)
    For M = 1 To UBound(Sh, 1)
        ShName = Sh(M, 1)
        sArr = Sheets(ShName).Range(Sheets(ShName).[C11], Sheets(ShName).[C65536].End(xlUp)).Offset(, -2).Resize(, 27).Value
        For I = 1 To UBound(sArr, 1)
            If UCase(sArr(I, 3)) = UCase(Nhom(N, 1)) Then
                Tem = sArr(I, 2)
                If Not Dic.exists(Tem) Then
                    K = K + 1: STT = STT + 1
                    Dic.Add Tem, K
                    dArr(K, 1) = STT
                    For J = 2 To 27
                        dArr(K, J) = sArr(I, J)
                        If J >= 8 Then Tong(1, J - 7) = Tong(1, J - 7) + sArr(I, J)
                    Next J
                    dArr(K, 28) = 1
                Else
                    X = Dic.Item(Tem)
                    dArr(X, 7) = sArr(I, 7)
                    For J = 8 To 27
                        dArr(X, J) = dArr(X, J) + sArr(I, J)
                        Tong(1, J - 7) = Tong(1, J - 7) + sArr(I, J)
                    Next J
                    dArr(X, 28) = dArr(X, 28) + 1
                End If
            End If
        Next I
    Next M
    For J = 1 To 20
        dArr(R, J + 7) = Tong(1, J)
        Tong(1, J) = 0
    Next J
Next N
[A10].Resize(1000, 28).ClearContents
[A10].Resize(K, 28) = dArr
[D10].Offset(K + 1).Value = [AF4].Value
[H10].Offset(K + 1).Resize(, 20).Value = "=SUM(R10C:R[-2]C)/2"
[H10].Offset(K + 1).Resize(, 20).Value = [H10].Offset(K + 1).Resize(, 20).Value
Set Dic = Nothing
End Sub
 
Upvote 0
Ba Tê đã viết:
Bạn nhập vào ô AF4="TỔNG CỘNG:"
Thay Sub cũ bằng cái này, rồi tự kiểm tra kết quả xem có đúng không nhé.
PHP: 
Public Sub TongHop()
Dim Dic As Object, Sh(), Nhom(), Tong(1 To 1, 1 To 20), N As Long, M As Long, I As Long, J As Long, K As Long, R As Long
Dim sArr(), dArr(1 To 1000, 1 To 28), Tem As String, ShName As String, STT As Long, X As Long
Set Dic = CreateObject("Scripting.Dictionary")
Sh = Range([AE6], [AE6].End(xlDown)).Value
Nhom = Range([AF6], [AF6].End(xlDown)).Value
For N = 1 To UBound(Nhom, 1)
    K = K + 1: R = K
    dArr(K, 4) = Nhom(N, 1)
    For M = 1 To UBound(Sh, 1)
        ShName = Sh(M, 1)
        sArr = Sheets(ShName).Range(Sheets(ShName).[C11], Sheets(ShName).[C65536].End(xlUp)).Offset(, -2).Resize(, 27).Value
        For I = 1 To UBound(sArr, 1)
            If UCase(sArr(I, 3)) = UCase(Nhom(N, 1)) Then
                Tem = sArr(I, 2)
                If Not Dic.exists(Tem) Then
                    K = K + 1: STT = STT + 1
                    Dic.Add Tem, K
                    dArr(K, 1) = STT
                    For J = 2 To 27
                        dArr(K, J) = sArr(I, J)
                        If J >= 8 Then Tong(1, J - 7) = Tong(1, J - 7) + sArr(I, J)
                    Next J
                    dArr(K, 28) = 1
                Else
                    X = Dic.Item(Tem)
                    dArr(X, 7) = sArr(I, 7)
                    For J = 8 To 27
                        dArr(X, J) = dArr(X, J) + sArr(I, J)
                        Tong(1, J - 7) = Tong(1, J - 7) + sArr(I, J)
                    Next J
                    dArr(X, 28) = dArr(X, 28) + 1
                End If
            End If
        Next I
    Next M
    For J = 1 To 20
        dArr(R, J + 7) = Tong(1, J)
        Tong(1, J) = 0
    Next J
Next N
[A10].Resize(1000, 28).ClearContents
[A10].Resize(K, 28) = dArr
[D10].Offset(K + 1).Value = [AF4].Value
[H10].Offset(K + 1).Resize(, 20).Value = "=SUM(R10C:R[-2]C)/2"
[H10].Offset(K + 1).Resize(, 20).Value = [H10].Offset(K + 1).Resize(, 20).Value
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ đúng rồi anh. Cảm ơn anh nhiều! Chúc anh ngủ ngon!
 
Upvote 0
Ba Tê đã viết:
Bạn nhập vào ô AF4="TỔNG CỘNG:"
Thay Sub cũ bằng cái này, rồi tự kiểm tra kết quả xem có đúng không nhé.
PHP: 
Public Sub TongHop()
Dim Dic As Object, Sh(), Nhom(), Tong(1 To 1, 1 To 20), N As Long, M As Long, I As Long, J As Long, K As Long, R As Long
Dim sArr(), dArr(1 To 1000, 1 To 28), Tem As String, ShName As String, STT As Long, X As Long
Set Dic = CreateObject("Scripting.Dictionary")
Sh = Range([AE6], [AE6].End(xlDown)).Value
Nhom = Range([AF6], [AF6].End(xlDown)).Value
For N = 1 To UBound(Nhom, 1)
    K = K + 1: R = K
    dArr(K, 4) = Nhom(N, 1)
    For M = 1 To UBound(Sh, 1)
        ShName = Sh(M, 1)
        sArr = Sheets(ShName).Range(Sheets(ShName).[C11], Sheets(ShName).[C65536].End(xlUp)).Offset(, -2).Resize(, 27).Value
        For I = 1 To UBound(sArr, 1)
            If UCase(sArr(I, 3)) = UCase(Nhom(N, 1)) Then
                Tem = sArr(I, 2)
                If Not Dic.exists(Tem) Then
                    K = K + 1: STT = STT + 1
                    Dic.Add Tem, K
                    dArr(K, 1) = STT
                    For J = 2 To 27
                        dArr(K, J) = sArr(I, J)
                        If J >= 8 Then Tong(1, J - 7) = Tong(1, J - 7) + sArr(I, J)
                    Next J
                    dArr(K, 28) = 1
                Else
                    X = Dic.Item(Tem)
                    dArr(X, 7) = sArr(I, 7)
                    For J = 8 To 27
                        dArr(X, J) = dArr(X, J) + sArr(I, J)
                        Tong(1, J - 7) = Tong(1, J - 7) + sArr(I, J)
                    Next J
                    dArr(X, 28) = dArr(X, 28) + 1
                End If
            End If
        Next I
    Next M
    For J = 1 To 20
        dArr(R, J + 7) = Tong(1, J)
        Tong(1, J) = 0
    Next J
Next N
[A10].Resize(1000, 28).ClearContents
[A10].Resize(K, 28) = dArr
[D10].Offset(K + 1).Value = [AF4].Value
[H10].Offset(K + 1).Resize(, 20).Value = "=SUM(R10C:R[-2]C)/2"
[H10].Offset(K + 1).Resize(, 20).Value = [H10].Offset(K + 1).Resize(, 20).Value
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Muôn tô đâm những dòng tổng cộng thì chỉnh code như thế nào hả anh!


Mã: 
Public Sub TongHop2()    Dim Dic As Object, Sh(), Nhom(), Tong(1 To 1, 1 To 20), N As Long, M As Long, I As Long, J As Long, K As Long, R As Long
    Dim sArr(), dArr(1 To 1000, 1 To 28), Tem As String, ShName As String, STT As Long, X As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    Sh = Range([AE6], [AE6].End(xlDown)).Value
    Nhom = Range([AF6], [AF6].End(xlDown)).Value
    For N = 1 To UBound(Nhom, 1)
        K = K + 1: R = K
        dArr(K, 4) = Nhom(N, 1)
        For M = 1 To UBound(Sh, 1)
            ShName = Sh(M, 1)
            sArr = Sheets(ShName).Range(Sheets(ShName).[C11], Sheets(ShName).[C65536].End(xlUp)).Offset(, -2).Resize(, 27).Value
            For I = 1 To UBound(sArr, 1)
                If UCase(sArr(I, 3)) = UCase(Nhom(N, 1)) Then
                    Tem = sArr(I, 2)
                    If Not Dic.exists(Tem) Then
                        K = K + 1: STT = STT + 1
                        Dic.Add Tem, K
                        dArr(K, 1) = STT
                        For J = 2 To 27
                            dArr(K, J) = sArr(I, J)
                            If J >= 8 Then Tong(1, J - 7) = Tong(1, J - 7) + sArr(I, J)
                        Next J
                        dArr(K, 28) = 1
                    Else
                        X = Dic.Item(Tem)
                        dArr(X, 7) = sArr(I, 7)
                        For J = 8 To 27
                            dArr(X, J) = dArr(X, J) + sArr(I, J)
                            Tong(1, J - 7) = Tong(1, J - 7) + sArr(I, J)
                        Next J
                        dArr(X, 28) = dArr(X, 28) + 1
                    End If
                End If
            Next I
        Next M
        For J = 1 To 20
            dArr(R, J + 7) = Tong(1, J)
            Tong(1, J) = 0
        Next J
    Next N
    [A10].Resize(1000, 28).ClearContents
    [A10].Resize(K, 28) = dArr
[COLOR=#ff0000]    If dArr(K, 3) = "" Then
        [A10].Resize(K, 28).Font.Bold = True
    End If[/COLOR]
    [D10].Offset(K + 1).Value = [AF4].Value
    [D10].Offset(K + 1).Resize(K, 28).Font.Bold = True
    [H10].Offset(K + 1).Resize(, 20).Value = "=SUM(R10C:R[-2]C)/2"
    [H10].Offset(K + 1).Resize(, 20).Value = [H10].Offset(K + 1).Resize(, 20).Value
    [A10].Resize(K + 2, 28).Borders.LineStyle = xlContinuous
    [A10].Resize(K + 2, 28).Borders(xlInsideVertical).Weight = 2
    [A10].Resize(K + 2, 28).Borders(xlInsideHorizontal).Weight = xlHairline
    Set Dic = Nothing
End Sub
Em có thêm vô 1 doạn code nhưng mà không có tác dụng gì hết nhờ anh kiểm tra dùm em
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

L
Tính thời gian làm việc thực tế (1 người xem)
Trả lời
66
Đọc
14K
YenTon
Y
H
Chia sẻ file in Phiếu điều tra PCGD (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
13
Đọc
630
Phuong7686
P
GPE-Trợ Lý
  • Dán lên cao
[KHẨN] HƯỚNG VỀ ĐỒNG BÀO CHỊU ẢNH HƯỞNG CỦA BÃO YAGI - BẢO YÊN, LÀO CAI (2 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
91
Đọc
14K
SA_DQ
SA_DQ
SA_DQ
Copilot bình luận về một ván cờ vua
    • Thích
Trả lời
6
Đọc
409
SA_DQ
SA_DQ
92nguyenthanh
  • Question Question
Vba cho file nhập xuất kho
Trả lời
4
Đọc
110
HUONGHCKT
H
C
Fix lỗi Application.InputBox Type:=8
    • Cười
Trả lời
25
Đọc
618
ptm0412
ptm0412
GPE-Trợ Lý
[GPE] TALK SHOW 08: GIẢI QUYẾT VẤN ĐỀ TỐI ƯU HÓA TRONG EXCEL VỚI CÔNG CỤ SOLVER
    • Thích
    • Cảm ơn
Trả lời
4
Đọc
3K
DuongLeHung
D
Gà Công Nghệ
Chế độ chính sách cho giáo viên mầm non giữ trẻ khuyết tật (1 người xem)
Trả lời
1
Đọc
58
vanle33
vanle33
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
22K
dunghtgiga
dunghtgiga
L
  • Question Question
Viết code tìm kiếm các file trong Folder
Trả lời
40
Đọc
12K
lan nguyen0987
L
P
Hyperlink_Cách chuyển cả thư mục và file tổng hợp sang máy khác không bị lỗi
Trả lời
5
Đọc
109
phongvanvu
P
HeSanbi
Tiện ích Web: Tự động nhấn nút "Bỏ qua" quảng cáo Youtube
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
ongke0711
ongke0711
ptm0412
Quá tin tưởng vào AI các thể loại
    • Cười
Trả lời
4
Đọc
218
Maika8008
Maika8008
A
  • Question Question
Không tìm được lỗi code
Trả lời
6
Đọc
159
ptm0412
ptm0412
W
Tham chiếu theo chuỗi ký tự
Trả lời
8
Đọc
315
dungpham01
D
tritv.dad
Lấy dữ liệu từ folder các tờ khai thông quan để theo dõi hiệu suất công việc.
Trả lời
8
Đọc
287
BlueSphere
B
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11 (2 người xem)
    • Thích
Trả lời
0
Đọc
3K
GPE-Trợ Lý
GPE-Trợ Lý
SA_DQ
Xin chúc mừng các thầy cô giáo trên cộng đồng nhân 20/11
    • Thích
    • Yêu thích
Trả lời
1
Đọc
135
BuiQuangThuan
B
M
chuyển đổi số thành chữ
Trả lời
15
Đọc
371
dungpham01
D
V
Lỗi copy sheet: the name already exists.
Trả lời
7
Đọc
702
nghiabros
N
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom