Tổng hợp số liệu bằng Dicitionay (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)
C

canguocs

Thành viên hoạt động
Tham gia
28/6/14
Bài viết
100
Được thích
7
PHP: 
[CODE]Sub TH()
Dim Dic As Object, sArr(), dArr(1 To 10000, 1 To 14), N As Long, I As Long, K As Long, Tem As String
Dim Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.Name <> "T_HOP" Then
        sArr = Ws.Range("B3", Ws.Range("B65000").End(3)).Resize(, 2).Value2
            For I = 1 To UBound(sArr, 1)
                Tem = UCase(sArr(I, 1))
                If Not Dic.Exists(Tem) Then
                    K = K + 1
                    Dic.Add Tem, ""
                    dArr(K, 1) = K
                    dArr(K, 2) = sArr(I, 1)
                    For N = 3 To 14
                        dArr(K, N) = sArr(I, 2)
                    Next
              
                End If
            Next
    End If
Next
Ws.[B3].Resize(I, 2).Value = sArr
Sheets("T_HOP").[A4:N5000].ClearContents
Sheets("T_HOP").[A4].Resize(K - 1, 14).Value = dArr


Set Dic = Nothing
End Sub


[/CODE]
Em có file cần tổng hợp bảng lương 12 tháng vào sheet T_HOP
em dùng Dic chạy Debug thấy sai, nhưng chưa biết sửa thế nào cho hợp lý.
Nhờ anh chị và các bạn giúp đỡ
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Mã: 
Ws.[B3].Resize(I, 2).Value = sArr
- Câu lệnh này có lẽ là hơi thừa vì dữ liệu trong các sheet vẫn y nguyên nên không cần phải khôi phục.
- Tham biến Ws lúc này nằm ngoài vòng lặp.
 
Upvote 0
Trong macro bạn tạo vòng lặp duyệt lần lượt từng trang tính (ngoại trừ trang tổng hợp); Điều này là cần thiết;
Nhưng tiếp theo, ở từng trang tính về lương các tháng, bạn lại duyệt theo [Số thứ tự]
Tuy nhiên số TT của 1 nhân viên qua các tháng không cố định sẽ làm bạn cộng của anh chàng này vô nàng kia!

Như là mình thì trước tiên mình cần tạo thêm 1 trường mã NV ở tất thẩy các trang tính. (Trường mã này sẽ được tạo ở tất thẩy các trang tính;

Công việc của macro là :

1./ Tạo vòng lặp (ngoài) duyệt toàn bộ các mã nhân viên tại trang 'T_Hop', từ đầu chí cuối;

2./ Tạo vòng lặp duyệt tất cả các trang tính có Left(Sh.Name,5)="Tháng"
(Hay Isnumeric(Right(Sh.Name,2) )
Điều kiện là mã của vòng lặp ngoài=mã của vòng lặp trong thì cộng thêm số tiền lương của tháng đó vô biến mảng, như

dArr(K, CByte(Right(Sh.name,2))) = sArr(I, 2)
 
Lần chỉnh sửa cuối:
Upvote 0
Mã: 
Public Sub TH_QUY()
Dim Dic As Object, Thang(), sArr(), dArr(1 To 10000, 1 To 14), N As Long, I As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
Thang = Range("A3:N3").Value
For N = 3 To 14
    With Sheets(Thang(1, N))
        sArr = .Range(.[B3], .[B3].End(xlDown)).Resize(, 2).Value
    End With
    For I = 1 To UBound(sArr, 1)
        Tem = UCase(sArr(I, 1))
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 1)
            dArr(K, N) = sArr(I, 2)
        Else
            dArr(Dic.Item(Tem), N) = sArr(I, 2)
        End If
    Next I
Next N
[A4].Resize(K, 14) = dArr ' dArr tren cung phai bang 6
Set Dic = Nothing
End Sub
Nếu sửa thế này em thấy cũng ok ah
 
Upvote 0
SA_DQ đã viết:
Trong macro bạn tạo vòng lặp duyệt lần lượt từng trang tính (ngoại trừ trang tổng hợp); Điều này là cần thiết;
Nhưng tiếp theo, ở từng trang tính về lương các tháng, bạn lại duyệt theo [Số thứ tự]
Tuy nhiên số TT của 1 nhân viên qua các tháng không cố định sẽ làm bạn cộng của anh chàng này vô nàng kia!

Như là mình thì trước tiên mình cần tạo thêm 1 trường mã NV ở tất thẩy các trang tính. (Trường mã này sẽ được tạo ở tất thẩy các trang tính;

Công việc của macro là :

1./ Tạo vòng lặp (ngoài) duyệt toàn bộ các mã nhân viên tại trang 'T_Hop', từ đầu chí cuối;

2./ Tạo vòng lặp duyệt tất cả các trang tính có Left(Sh.Name,5)="Tháng"
(Hay Isnumeric(Right(Sh.Name,2) )
Điều kiện là mã của vòng lặp ngoài=mã của vòng lặp trong thì cộng thêm số tiền lương của tháng đó vô biến mảng, như

dArr(K, CByte(Right(Sh.name,2))) = sArr(I, 2)
Nhấp chuột vào đây để mở rộng...
Duyệt vòng lặp ngoài đúng là em ko nghĩ được tới , vì kiến thức còn giới hạn, Nếu được Thấy có thể giúp em học hỏi thêm ah
 
Upvote 0
BÀi 5 đã giải quyết được vấn đề nhưng em muốn tìm hiểu giải theo cách Bài #1 , nhờ anh chị giúp đỡ
 
Upvote 0
canguocs đã viết:
BÀi 5 đã giải quyết được vấn đề nhưng em muốn tìm hiểu giải theo cách Bài #1 , nhờ anh chị giúp đỡ
Nhấp chuột vào đây để mở rộng...
Làm lại code dựa theo bài 1
Code cũ
Mã: 
Option Explicit
Sub TH()
Dim Dic As Object, sArr(), dArr(1 To 10000, 1 To 14), N As Long, I As Long, K As Long, Tem As String
Dim Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.Name <> "T_HOP" Then
        sArr = Ws.Range("B3", Ws.Range("B65000").End(3)).Resize(, 2).Value2
            For I = 1 To UBound(sArr, 1)
                Tem = UCase(sArr(I, 1))
                If Not Dic.Exists(Tem) Then
                    K = K + 1
                    Dic.Add Tem, ""
                    dArr(K, 1) = K
                    dArr(K, 2) = sArr(I, 1)
                    [I]For N = 3 To 14[/I]          'Bỏ vòng lặp này
[I]                        dArr(K, N) = sArr(I, 2)
                    Next
[/I]              
                End If
            Next
    End If
Next
Ws.[B3].Resize(I, 2).Value = sArr     'Bỏ câu này
Sheets("T_HOP").[A4:N5000].ClearContents
Sheets("T_HOP").[A4].Resize(K - 1, 14).Value = dArr

Set Dic = Nothing
End Sub

Sửa thế này xem sao
Mã: 
Sub TH_SC()
Dim Dic As Object, sArr(), dArr(1 To 10000, 1 To 14), N As Long, I As Long, K As Long, Tem As String 
Dim Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
If Ws.Name <> "T_HOP" Then
N = N + 1                         'Đưa biến N lên đây vì mỗi lần chuyển sheet là sang cột mới của dArr
sArr = Ws.Range("B3", Ws.Range("B65000").End(3)).Resize(, 2).Value2
For I = 1 To UBound(sArr, 1)
Tem = UCase(sArr(I, 1))

If Not Dic.Exists(Tem) Then  'Nếu Dic chưa có Tem
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = K
dArr(K, 2) = sArr(I, 1)
dArr(K, N + 2) = sArr(I, 2)
Else                                  'Nếu Dic đã có Tem
dArr(Dic.Item(Tem), N + 2) = sArr(I, 2)
End If
Next I
End If
Next Ws
Sheets("T_HOP").[A4:N5000].ClearContents
Sheets("T_HOP").[A4].Resize(K - 1, 14).Value = dArr

Set Dic = Nothing
End Sub
Bạn kiểm tra xem sao
 
Lần chỉnh sửa cuối:
Upvote 0
HungQuoc49 đã viết:
Làm lại code dựa theo bài 1
Sửa thế này xem sao
Mã: 
Sub TH_SC()
Dim Dic As Object, sArr(), dArr(1 To 10000, 1 To 14), N As Long, I As Long, K As Long, Tem As String 
Dim Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
If Ws.Name <> "T_HOP" Then
N = N + 1                         'Đưa biến N lên đây vì mỗi lần chuyển sheet là sang cột mới của dArr
sArr = Ws.Range("B3", Ws.Range("B65000").End(3)).Resize(, 2).Value2
For I = 1 To UBound(sArr, 1)
Tem = UCase(sArr(I, 1))

If Not Dic.Exists(Tem) Then  'Nếu Dic chưa có Tem
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = K
dArr(K, 2) = sArr(I, 1)
dArr(K, N + 2) = sArr(I, 2)
Else                                  'Nếu Dic đã có Tem
dArr(Dic.Item(Tem), N + 2) = sArr(I, 2)
End If
Next I
End If
Next Ws
Sheets("T_HOP").[A4:N5000].ClearContents
Sheets("T_HOP").[A4].Resize(K - 1, 14).Value = dArr

Set Dic = Nothing
End Sub
Bạn kiểm tra xem sao
Nhấp chuột vào đây để mở rộng...
Code này có 2 vấn đề:
1) Sai:
Sheets("T_HOP").[A4].Resize(K - 1, 14).Value = dArr
Nhấp chuột vào đây để mở rộng...
phải là:
Sheets("T_HOP").[A4].Resize(K, 14).Value = dArr
Nhấp chuột vào đây để mở rộng...
2) Không an toàn:
Trong bảng tổng hợp thì các tháng xếp theo thứ tự thì ok, nhưng trong file vì lý do nào đó các sheet không theo thứ tự từ 1 đến 12 thì code này "tèo". Có thể tránh trường hợp này bằng cách gán giá trị số trong tên Sheet vào biến N ( đây chỉ là một cách)
Thân
 
Upvote 0
concogia đã viết:
Code này có 2 vấn đề:
1) Sai:

phải là:

2) Không an toàn:
Trong bảng tổng hợp thì các tháng xếp theo thứ tự thì ok, nhưng trong file vì lý do nào đó các sheet không theo thứ tự từ 1 đến 12 thì code này "tèo". Có thể tránh trường hợp này bằng cách gán giá trị số trong tên Sheet vào biến N ( đây chỉ là một cách)
Thân
Nhấp chuột vào đây để mở rộng...
Quả là đúng vậy.
Thấy chủ thớt vẫn có ý sử dụng theo hướng của bài 1 nên cũng chỉ sửa lại một vài chỗ tính toán mà không hiệu chỉnh các câu lệnh còn lại ( Nhất là tại mục 2).
Thanks!
 
Upvote 0
HungQuoc49 đã viết:
Làm lại code dựa theo bài 1
Code cũ
Mã: 
Option Explicit
Sub TH()
Dim Dic As Object, sArr(), dArr(1 To 10000, 1 To 14), N As Long, I As Long, K As Long, Tem As String
Dim Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.Name <> "T_HOP" Then
        sArr = Ws.Range("B3", Ws.Range("B65000").End(3)).Resize(, 2).Value2
            For I = 1 To UBound(sArr, 1)
                Tem = UCase(sArr(I, 1))
                If Not Dic.Exists(Tem) Then
                    K = K + 1
                    Dic.Add Tem, ""
                    dArr(K, 1) = K
                    dArr(K, 2) = sArr(I, 1)
                    [I]For N = 3 To 14[/I]          'Bỏ vòng lặp này
[I]                        dArr(K, N) = sArr(I, 2)
                    Next
[/I]              
                End If
            Next
    End If
Next
Ws.[B3].Resize(I, 2).Value = sArr     'Bỏ câu này
Sheets("T_HOP").[A4:N5000].ClearContents
Sheets("T_HOP").[A4].Resize(K - 1, 14).Value = dArr

Set Dic = Nothing
End Sub

Sửa thế này xem sao
Mã: 
Sub TH_SC()
Dim Dic As Object, sArr(), dArr(1 To 10000, 1 To 14), N As Long, I As Long, K As Long, Tem As String 
Dim Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
If Ws.Name <> "T_HOP" Then
N = N + 1                         'Đưa biến N lên đây vì mỗi lần chuyển sheet là sang cột mới của dArr
sArr = Ws.Range("B3", Ws.Range("B65000").End(3)).Resize(, 2).Value2
For I = 1 To UBound(sArr, 1)
Tem = UCase(sArr(I, 1))

If Not Dic.Exists(Tem) Then  'Nếu Dic chưa có Tem
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = K
dArr(K, 2) = sArr(I, 1)
dArr(K, N + 2) = sArr(I, 2)
Else                                  'Nếu Dic đã có Tem
dArr(Dic.Item(Tem), N + 2) = sArr(I, 2)
End If
Next I
End If
Next Ws
Sheets("T_HOP").[A4:N5000].ClearContents
Sheets("T_HOP").[A4].Resize(K - 1, 14).Value = dArr

Set Dic = Nothing
End Sub
Bạn kiểm tra xem sao
Nhấp chuột vào đây để mở rộng...
Ok, em cảm ơn bác, lúc đầu em đã đưa biến N lên nhưng chưa đúng cách
 
Upvote 0
concogia đã viết:
Code này có 2 vấn đề:
1) Sai:

phải là:

2) Không an toàn:
Trong bảng tổng hợp thì các tháng xếp theo thứ tự thì ok, nhưng trong file vì lý do nào đó các sheet không theo thứ tự từ 1 đến 12 thì code này "tèo". Có thể tránh trường hợp này bằng cách gán giá trị số trong tên Sheet vào biến N ( đây chỉ là một cách)
Thân
Nhấp chuột vào đây để mở rộng...

Em cảm ơn Thầy nhiều nhé
 
Upvote 0
canguocs đã viết:
BÀi 5 đã giải quyết được vấn đề nhưng em muốn tìm hiểu giải theo cách Bài #1 , nhờ anh chị giúp đỡ
Nhấp chuột vào đây để mở rộng...

Sao nhìn code quen quen.
Viết lại như vầy xem sao:
PHP: 
Sub TH()
Dim Dic As Object, sArr(), dArr(1 To 1000, 1 To 14), I As Long
Dim Ws As Worksheet, Col As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If IsNumeric(Right(Ws.Name, 1)) Then
        Col = Right(Ws.Name, 2) + 2
        sArr = Ws.Range("B3", Ws.Range("B65536").End(xlUp)).Resize(, 2).Value
            For I = 1 To UBound(sArr, 1)
                Tem = UCase(sArr(I, 1))
                If Not Dic.Exists(Tem) Then
                    K = K + 1
                    Dic.Add Tem, K
                    dArr(K, 1) = K
                    dArr(K, 2) = sArr(I, 1)
                    dArr(K, Col) = sArr(I, 2)
                Else
                    dArr(Dic.Item(Tem), Col) = sArr(I, 2)
                End If
            Next I
    End If
Next
With Sheets("T_HOP")
    .[A4:N1000].ClearContents
    .[A4].Resize(K, 14).Value = dArr
End With
Set Dic = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Sao nhìn code quen quen.
Viết lại như vầy xem sao:
PHP: 
Sub TH()
Dim Dic As Object, sArr(), dArr(1 To 1000, 1 To 14), I As Long
Dim Ws As Worksheet, Col As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If IsNumeric(Right(Ws.Name, 1)) Then
        Col = Right(Ws.Name, 2) + 2
        sArr = Ws.Range("B3", Ws.Range("B65536").End(xlUp)).Resize(, 2).Value
            For I = 1 To UBound(sArr, 1)
                Tem = UCase(sArr(I, 1))
                If Not Dic.Exists(Tem) Then
                    K = K + 1
                    Dic.Add Tem, K
                    dArr(K, 1) = K
                    dArr(K, 2) = sArr(I, 1)
                    dArr(K, Col) = sArr(I, 2)
                Else
                    dArr(Dic.Item(Tem), Col) = sArr(I, 2)
                End If
            Next I
    End If
Next
With Sheets("T_HOP")
    .[A4:N1000].ClearContents
    .[A4].Resize(K, 14).Value = dArr
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Đương nhiên là quen rồi Thầy, của Thầy mà, sau em chế thành 12 tháng ah. Em cảm ơn Thầy nhé. Bién Col or N do em đưa lên trên rồi nhưng sai cách nên không ra. Thầy gán giá trị số vào biến N nên đã giải quyết được tình huống của Thầy concogia roài
 
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
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
13
Đọc
627
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
    • 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 (1 người xem)
Trả lời
4
Đọc
107
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
Trả lời
1
Đọc
57
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
108
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ự (1 người xem)
Trả lời
8
Đọc
314
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
286
BlueSphere
B
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11 (1 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