Làm báo cáo bằng VBA

Liên hệ QC
V

Van Nong

Thành viên mới
Tham gia
10/1/19
Bài viết
6
Được thích
0
Xin các sư phụ chỉ giáo ạ.

Thay vì dùng các hàm trong excel, Em muốn làm báo cáo dùng code VBA để hiện giá trị. File mẫu em có đình kèm, mong các sư phụ giúp em ạ.

Em cảm ơn.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Van Nong đã viết:
Xin các sư phụ chỉ giáo ạ.

Thay vì dùng các hàm trong excel, Em muốn làm báo cáo dùng code VBA để hiện giá trị. File mẫu em có đình kèm, mong các sư phụ giúp em ạ.

Em cảm ơn.
Nhấp chuột vào đây để mở rộng...
Đây bạn xem code.
Mã: 
Sub baocao()
Dim arr, arr1, dic As Object, i As Long, j As Long, a As Long, lr As Long, dk As String, dks As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("Total_ung_vien")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     arr = .Range("A3:B" & lr).Value
     For i = 1 To UBound(arr, 1)
         dk = arr(i, 1)
         dks = arr(i, 1) & "#" & arr(i, 2)
         If Not dic.exists(dk) Then
            dic.Add dk, 1
         Else
            dic.Item(dk) = dic.Item(dk) + 1
         End If
         If Not dic.exists(dks) Then
            dic.Add dks, 1
         Else
            dic.Item(dks) = dic.Item(dks) + 1
         End If
     Next i
End With
With Sheets("Tuyen_dung")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     arr = .Range("A5:d" & lr).Value
     For i = 1 To UBound(arr, 1)
         dk = arr(i, 1) & "#" & arr(i, 2)
         dks = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3)
         If Not dic.exists(dk) Then
            dic.Add dk, 1
         Else
            dic.Item(dk) = dic.Item(dk) + 1
         End If
         If Not dic.exists(dks) Then
            dic.Add dks, 1
         Else
            dic.Item(dks) = dic.Item(dks) + 1
         End If
     Next i
End With
With Sheets("BAOCAO")
           .Range("B6:G9").ClearContents
     arr = .Range("a6:G9").Value
     For i = 1 To UBound(arr, 1)
         If dic.exists(arr(i, 1)) Then
            arr(i, 2) = dic.Item(arr(i, 1))
         End If
         dk = arr(i, 1) & "#" & "Dat_yeu_cau"
         If dic.exists(dk) Then
            arr(i, 3) = dic.Item(dk)
         End If
         arr(i, 4) = arr(i, 3) / arr(i, 2)
         dk = arr(i, 1) & "#" & "Pass"
         If dic.exists(dk) Then
            arr(i, 5) = dic.Item(dk)
         End If
         dk = arr(i, 1) & "#" & "Pass" & "#" & "Nghi_viec"
         If dic.exists(dk) Then
            arr(i, 6) = dic.Item(dk)
         End If
         arr(i, 7) = arr(i, 6) / arr(i, 5)
     Next i
     .Range("a6:G9").Value = arr
End With
End Sub
End Sub[/CODE]
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
snow25 đã viết:
Đây bạn xem code.
Mã: 
Sub baocao()
Dim arr, arr1, dic As Object, i As Long, j As Long, a As Long, lr As Long, dk As String, dks As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("Total_ung_vien")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     arr = .Range("A3:B" & lr).Value
     For i = 1 To UBound(arr, 1)
         dk = arr(i, 1)
         dks = arr(i, 1) & "#" & arr(i, 2)
         If Not dic.exists(dk) Then
            dic.Add dk, 1
         Else
            dic.Item(dk) = dic.Item(dk) + 1
         End If
         If Not dic.exists(dks) Then
            dic.Add dks, 1
         Else
            dic.Item(dks) = dic.Item(dks) + 1
         End If
     Next i
End With
With Sheets("Tuyen_dung")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     arr = .Range("A5:d" & lr).Value
     For i = 1 To UBound(arr, 1)
         dk = arr(i, 1) & "#" & arr(i, 2)
         dks = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3)
         If Not dic.exists(dk) Then
            dic.Add dk, 1
         Else
            dic.Item(dk) = dic.Item(dk) + 1
         End If
         If Not dic.exists(dks) Then
            dic.Add dks, 1
         Else
            dic.Item(dks) = dic.Item(dks) + 1
         End If
     Next i
End With
With Sheets("BAOCAO")
           .Range("B6:G9").ClearContents
     arr = .Range("a6:G9").Value
     For i = 1 To UBound(arr, 1)
         If dic.exists(arr(i, 1)) Then
            arr(i, 2) = dic.Item(arr(i, 1))
         End If
         dk = arr(i, 1) & "#" & "Dat_yeu_cau"
         If dic.exists(dk) Then
            arr(i, 3) = dic.Item(dk)
         End If
         arr(i, 4) = arr(i, 3) / arr(i, 2)
         dk = arr(i, 1) & "#" & "Pass"
         If dic.exists(dk) Then
            arr(i, 5) = dic.Item(dk)
         End If
         dk = arr(i, 1) & "#" & "Pass" & "#" & "Nghi_viec"
         If dic.exists(dk) Then
            arr(i, 6) = dic.Item(dk)
         End If
         arr(i, 7) = arr(i, 6) / arr(i, 5)
     Next i
     .Range("a6:G9").Value = arr
End With
End Sub
End Sub[/CODE]
Nhấp chuột vào đây để mở rộng...
Em cảm ơn đại ca rất nhiều :-*
Bài đã được tự động gộp:

Em cảm ơn đại ca rất nhìu :-*
 
Upvote 0
snow25 đã viết:
Đây bạn xem code.
Mã: 
Sub baocao()
Dim arr, arr1, dic As Object, i As Long, j As Long, a As Long, lr As Long, dk As String, dks As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("Total_ung_vien")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     arr = .Range("A3:B" & lr).Value
     For i = 1 To UBound(arr, 1)
         dk = arr(i, 1)
         dks = arr(i, 1) & "#" & arr(i, 2)
         If Not dic.exists(dk) Then
            dic.Add dk, 1
         Else
            dic.Item(dk) = dic.Item(dk) + 1
         End If
         If Not dic.exists(dks) Then
            dic.Add dks, 1
         Else
            dic.Item(dks) = dic.Item(dks) + 1
         End If
     Next i
End With
With Sheets("Tuyen_dung")
     lr = .Range("A" & Rows.Count).End(xlUp).Row
     arr = .Range("A5:d" & lr).Value
     For i = 1 To UBound(arr, 1)
         dk = arr(i, 1) & "#" & arr(i, 2)
         dks = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3)
         If Not dic.exists(dk) Then
            dic.Add dk, 1
         Else
            dic.Item(dk) = dic.Item(dk) + 1
         End If
         If Not dic.exists(dks) Then
            dic.Add dks, 1
         Else
            dic.Item(dks) = dic.Item(dks) + 1
         End If
     Next i
End With
With Sheets("BAOCAO")
           .Range("B6:G9").ClearContents
     arr = .Range("a6:G9").Value
     For i = 1 To UBound(arr, 1)
         If dic.exists(arr(i, 1)) Then
            arr(i, 2) = dic.Item(arr(i, 1))
         End If
         dk = arr(i, 1) & "#" & "Dat_yeu_cau"
         If dic.exists(dk) Then
            arr(i, 3) = dic.Item(dk)
         End If
         arr(i, 4) = arr(i, 3) / arr(i, 2)
         dk = arr(i, 1) & "#" & "Pass"
         If dic.exists(dk) Then
            arr(i, 5) = dic.Item(dk)
         End If
         dk = arr(i, 1) & "#" & "Pass" & "#" & "Nghi_viec"
         If dic.exists(dk) Then
            arr(i, 6) = dic.Item(dk)
         End If
         arr(i, 7) = arr(i, 6) / arr(i, 5)
     Next i
     .Range("a6:G9").Value = arr
End With
End Sub
End Sub[/CODE]
Nhấp chuột vào đây để mở rộng...
Bài đã được tự động gộp:

Anh ơi, giúp em cái file này nữa ạ, em làm thử nhưng chưa được, cảm ơn anh
 

File đính kèm

Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
0
Đọc
39
Việt Nguyễn 86
Việt Nguyễn 86
K
Mong giúp dữ liệu từ trang web sang excel
Trả lời
0
Đọc
46
khanhvinhdai1
K
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
    • Thích
Trả lời
0
Đọc
423
GPE-Trợ Lý
GPE-Trợ Lý
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
3
Đọc
1K
trung_bhxh
T
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
Trả lời
0
Đọc
53
trung_bhxh
T
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
52
Đọc
103K
khanhvinhdai1
K
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
5
Đọc
101
ptm0412
ptm0412
Huyen9
Lỗi không mailings được.
Trả lời
3
Đọc
77
vanle33
vanle33
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
310
Đọc
23K
kunkoi9390
K
K
Có ai giúp mình lấy kết quả xổ số miền nam về file excel
Trả lời
0
Đọc
39
khanhvinhdai1
K
ptm0412
  • Question Question
Lấy dữ liệu web nhiều trang về file Excel bằng Power Query
    • Thích
Trả lời
5
Đọc
2K
ptm0412
ptm0412
H
Công thức tìm kết quả
Trả lời
11
Đọc
123
VetMini
V
V
Hàm dò tìm lấy giá trị của lần xuất hiện thứ n trong excel.
Trả lời
9
Đọc
1K
VetMini
V
N
Nhờ các anh chỉ chỉnh lỗi giúp em với ạ, em cảm ơn ạ.
Trả lời
3
Đọc
82
minhminh27
minhminh27
T
File quản lý thiết bị trong trường học!
Trả lời
4
Đọc
138
VetMini
V
Xoainon3005
Xin file mẫu kế hoạch sản xuất theo tháng ngành động cơ
Trả lời
1
Đọc
126
VetMini
V
Momominh
Sơ đồ hàng hóa trong Container
Trả lời
3
Đọc
133
VetMini
V
hungtin1997
  • Question Question
[Hỏi] Tạo Hyperlink đến ô chạy ngang theo cột
Trả lời
6
Đọc
416
A HOANG 620
A
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
14
Đọc
564
htin1997
htin1997
tramcannt
Các bác cho hỏi làm cách nào để thu nhỏ thanh công thức này với ạ. Em cảm ơn.
Trả lời
2
Đọc
63
Nhattanktnn
Nhattanktnn
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom