(SKKN 2022) sử dụng VBA trong excel để lập báo cáo kết quả thi và tư vấn tổ hợp xét tuyển cho học sinh

SỞ GIÁO DỤC VÀ ĐÀO TẠO THANH HÓA TRƯỜNG THPT DÂN TỘC NỘI TRÚ NGỌC LẶC SÁNG KIẾN KINH NGHIỆM SỬ DỤNG VBA TRONG EXCEL ĐỂ LẬP BÁO CÁO KẾT QUẢ THI VÀ TƯ VẤN TỔ HỢP XÉT TUYỂN CHO HỌC SINH Người thực hiện: Lê Xuân Thế Chức vụ: Tổ trưởng chuyên môn SKKN thuộc lĩnh vực (môn): Khác THANH HÓA NĂM 2022 MỤC LỤC Mở đầu 1.1 Lí chọn đề tài 1.2 Mục đích nghiên cứu 1.3 Đối tượng nghiên cứu 1.4 Phương pháp nghiên cứu 2 Nội dung sáng kiến kinh nghiệm 2.1 Cơ sở lí luận sáng kiến kinh nghiệm 2.2 Thực trạng vấn đề trước áp dụng sáng kiến kinh nghiệm 2.3 Các sáng kiến kinh nghiệm giải pháp sử dụng để giải vấn đề 2.3.1 Hướng dẫn sử dụng .4 2.3.1.1 Tạo file Excel liệu 2.3.1.2 Tạo module viết code 2.3.1.3 Viết code cho thủ tục 2.3.1.4 Tạo nút chạy gán marco 2.3.2 Hướng phát triển 10 2.4 Hiệu sáng kiến kinh nghiệm hoạt động giáo dục, với thân, đồng nghiệp nhà trường .10 Kết luận, kiến nghị 12 3.1 Kết luận 12 3.2 Kiến nghị 12 TÀI LIỆU THAM KHẢO 13 Mở đầu 1.1 Lí chọn đề tài Xu giáo dục đại khẳng định việc ứng dụng khoa học cơng nghệ vào đời sống nói chung lĩnh vực giáo dục nói riêng vơ to lớn Vai trị thể số khía cạnh sau đây: Người dạy học dễ dàng thu thập, tổng hợp, lưu trữ lượng kiến thức phong phú đa dạng cập nhật thường xuyên; Ứng dụng cơng nghệ vào giảng dạy có vai trị thúc đẩy giáo dục mở, giúp hoạt động giáo dục đạt hiệu cao Việc ứng dụng công nghệ thông tin Nhà trường phù hợp với chủ trương, sách Đảng, Nhà nước Bộ Giáo dục Đào tạo Để nâng cao hiệu việc xây dựng báo cáo số liệu cho Sở GD&ĐT, UBND huyện nhanh chóng, xác Phân tích số liệu qua đợt thi thử Tốt nghiệp, tư vấn cho học sinh tổ hợp xét tuyển tối ưu Tôi xin đưa sáng kiến kinh nghiệm: “SỬ DỤNG VBA TRONG EXCEL ĐỂ LẬP BÁO CÁO KẾT QUẢ THI VÀ TƯ VẤN TỔ HỢP XÉT TUYỂN CHO HỌC SINH” 1.2 Mục đích nghiên cứu Sự phát triển cơng nghệ khiến tri thức nhân loại không ngừng tăng lên theo cấp số nhân, Tập liệu có khối lượng lớn phức tạp Độ lớn đến mức cần phần mềm xử lý liệu chuyên nghiệp có khả thu thập, quản lý xử lý liệu khoảng thời gian hợp lý Là người giao nhiệm vụ báo cáo kết sau kì thi với Sở GD&ĐT, UBND Huyện, Ban giám hiệu Tổng hợp báo cáo số liệu u cầu nhanh chóng, xác, nhiều cấu trúc diễn liên tục Nên việc sử dụng VBA Excel cần thiết, đáp ứng với nhiều trường, không phụ thuộc số lượng học sinh tham gia Tổ hợp xét tuyển thể phần chữ (A, B, C, D, H,… ) để nhận biết khối thi phần số (00, 01, 02, ) để nhận biết tổ hợp Có 185 tổ hợp Việc sử dụng VBA Excel tính nhanh kết điểm tổ hợp xét tuyển học sinh, từ học sinh đưa phương án ôn tập tốt nhất, đạt hiệu cao xét tuyển 1.3 Đối tượng nghiên cứu VBA ngơn ngữ lập trình máy tính viết tắt Visual Basic for Applications sử dụng để tự động hóa chức nhiệm vụ Microsoft Excel Các chương trình Visual Basic for Applications gọi Macro Excel VBA Macro Macro Microsoft Excel tất sản phẩm Microsoft Office Word, PowerPoint, Access, Outlook đạt tiêu chuẩn với VBA Bạn khơng phải mua Đừng nhầm lẫn VBA với VB.NET Vì VB.NET “anh cả” Visual Basic for Applications VB.NET chia sẻ nhiều thuộc tính tốt VBA nữa, khó sử dụng nhiều địi hỏi nhiều thời gian kiến thức để thành thạo sử dụng Mặt khác, Visual Basic for Applications dễ vận hành học hỏi sử dụng điểm khởi đầu để vào VB.NET VBA kiểm soát Microsoft Excel cách viết chạy quy trình cịn gọi macro Các quy trình Visual Basic for Applications viết VBA Editor mà bạn nhận cách nhấn Alt + F11 Excel Các lệnh Excel nhập vào mã máy tính cho Excel biết phải làm chúng chạy theo trình tự Ngồi lệnh Excel, VBA cịn sở hữu yếu tố lập trình máy tính khác logic, vòng lặp chức cho phép chương trình phức tạp phát triển gần đối thủ vượt qua nhiều chương trình thị trường Sử dụng VBA với Excel, cơng cụ phân tích mạnh mẽ phát triển nhanh chóng với chi phí tối thiểu Mơi trường làm việc có mạng Internet, máy tính Windows, Microsoft Office 1.4 Phương pháp nghiên cứu - Phương pháp nghiên cứu tài liệu - Phương pháp thực nghiệm - Phương pháp thống kê Nội dung sáng kiến kinh nghiệm 2.1 Cơ sở lí luận sáng kiến kinh nghiệm Cơng nghệ thông tin thuật ngữ dùng để ngành khoa học công nghệ liên quan đến thông tin q trình xử lý thơng tin Như vậy, “CNTT hệ thống phương pháp khoa học, công nghệ, phương tiện, công cụ, bao gồm chủ yếu máy tính, mạng truyền thơng hệ thống kho liệu nhằm tổ chức, lưu trữ, truyền dẫn khai thác, sử dụng có hiệu thông tin lĩnh vực hoạt động kinh tế, xã hội, văn hóa,… người” Ở Việt Nam, khái niệm CNTT hiểu định nghĩa Nghị số 49/CP Chính phủ ký ngày 04/08/1993 “Phát triển CNTT nước ta năm 90”: CNTT tập hợp phương pháp khoa học, phương tiện công cụ kỹ thuật đại - chủ yếu kỹ thuật máy tính viễn thơng nhằm tổ chức, khai thác sử dụng có hiệu nguồn tài nguyên thông tin phong phú tiềm tàng lĩnh vực hoạt động người xã hội Trong hướng dẫn thực nhiệm vụ năm học năm Năm học 2019 2020, ngành Giáo dục tiếp tục tập trung thực Nghị số 29-NQ/TW ngày 04/11/2013 Ban Chấp hành Trung ương Đảng, Nghị số 44/NQ-CP ngày 09/6/2014 Chính phủ đổi bản, tồn diện giáo dục đào tạo; Nghị số 88/2014/QH13 ngày 28/11/2014 Quốc hội khóa XIII, Nghị số 51/2017/QH14 ngày 21/11/2017 Quốc hội khóa XIV Chỉ thị số 16/CTTTg ngày 18/6/2018 Thủ tướng Chính phủ đổi chương trình, sách giáo khoa giáo dục phổ thơng; Nghị Đảng, Quốc hội, Chính phủ đạo Thủ tướng Chính phủ Mã quy ước tổ hợp mơn xét tuyển ĐH, CĐ quy thực dựa vào nội dung hướng dẫn theo Công văn số 310/KTKĐCLGD-TS ngày 20 tháng 03 năm 2015 Bộ Giáo dục Đào tạo Bảng mã hóa tổ hợp môn thi xét tuyển Đại học, Cao đẳng quy Cục Khảo thí Kiểm định chất lượng giáo dục, Bộ GD&ĐT thống kê Theo đó, mã quy ước tổ hợp môn xét tuyển bao gồm 10 tổ hợp môn thi truyền thống 91 tổ hợp mơn thi Ngồi ra, trường Đại học, CĐ lựa chọn tổ hợp môn xét tuyển dựa vào ngành đào tạo yêu cầu riêng trường 2.2 Thực trạng vấn đề trước áp dụng sáng kiến kinh nghiệm Công tác báo cáo Sở GD&ĐT kết thi khảo sát Tốt nghiệp Phòng KT&KĐCLGD yêu cầu thường xuyên Trước đây, sau thi xong, kết đếm "bo" để lấy liệu Tuy số liệu xác vất vả File nhập liệu trực tuyến Công tác báo cáo kết thi với Ban giám hiệu nhà trường địi hỏi nhanh chóng, so sánh làm bật kết lớp Trước đây, chưa sử dụng VBA, việc tính tốn có áp dụng cơng thức Excel Do bảng biểu sử dụng công thức nên số lượng học sinh thay đổi, số lớp thay đổi việc điều chỉnh tốn thời gian, file chia sẻ khó áp dụng Trong cơng tác tư vấn tổ hợp xét tuyển cho học sinh lớp 12 Các Thầy giáo gặp khơng khó khăn số lượng tổ hợp lớn Điểm tổ hợp lớn nhất, phù hợp với học sinh, tổ hợp gồm mơn Trường THPT DTNT Ngọc Lặc ngơi trường có học sinh nhiều huyện khác Năm 2021, trường đạt thành tích cao kì thi Tốt nghiệp, đứng thứ toàn tỉnh điểm trung bình mơn, nhận quan tâm UBND huyện Tuy nhiên, huyện lại có yêu cầu để thưởng khác Có huyện học sinh huyện đạt từ 27 điểm tổ hợp xét tuyển Có huyện lại yêu cầu thêm tổ hợp phải đăng kí nguyện vọng lần đầu Nếu khơng có VBA hỗ trợ cơng tác báo cáo tốn nhiều thời gian 2.3 Các sáng kiến kinh nghiệm giải pháp sử dụng để giải vấn đề 2.3.1 Hướng dẫn sử dụng 2.3.1.1 Tạo file Excel liệu File liệu Excel thiết kế sau: Gồm có sheet: Sheet4: Sh_01: Là liệu gồm 30 cột, chứa liệu cần thiết gồm cột: Số vnedu, Họ tên, điểm thi (cột đến 17) Được trích xuất từ vnedu tổ chức thi thử, khảo sát đợt Còn cột 18 đến 30, VBA tính tốn nháy vào nút số   Sheet2: Chung (VL): Được thiết kế vừa trang A4 in ngang, toàn liệu chép từ sheet khác Khi nháy vào nút số (ô B1) liệu làm Còn nháy vào nút số 2, 3, 4, VBA xếp lại liệu cột Mục đích để in niêm yết theo phương án khác Ví dụ: Nháy vào nút đẻ xếp theo lớp Để tránh rườm in, ta ấn Ctrl nút, chọn đường viền nút không màu Sheet3: BaocaoSo: Được thiết kế theo form báo cáo file trực tuyến Phòng KT&KĐCLGD, Sở GD&ĐT Thanh Hóa Khi nháy nút (ô B1) VBA load liệu từ sheet1 Trong sheet cịn có phần báo cáo riêng cấp trường theo yêu cầu Ban giám hiệu: Sheet5: KetnoiDL: Dữ liệu sheet quan trọng, xây dựng từ đầu năm lớp 12 Thực kiểm dò nhiều lần Sửa xong cần khóa lại tránh sai sót vơ tình Mã vnedu học sinh sheet sử dụng để tham chiếu Ví dụ lấy liệu ngày sinh, lớp, T.H (học sinh chọn tổ hợp KHTN đánh dấu x), điểm trung bình lớp 12, điểm khuyến khích, điểm ưu tiên Sheet1: Cactohop: Được cấu trúc dựa vào mã quy ước tổ hợp môn xét tuyển ĐH, CĐ quy thực dựa vào nội dung hướng dẫn theo Công văn số 310/KTKĐCLGD-TS ngày 20 tháng 03 năm 2015 Bộ Giáo dục Đào tạo 2.3.1.2 Tạo module viết code Để vào phần module chứa code thực thi, ta ấn tổ hợp phím Alt+F11 Cửa sổ VBA viết tắt từ Visual Basic For Applications VBA thường lập trình ứng dụng văn phịng Word, Excel, PowerPoint, Có thể hiểu tất ngơn ngữ sử dụng Excel sử dụng ngôn ngữ VBA Trong kỹ thuật ngơn ngữ VBA ngơn ngữ lập trình hướng vào kiện riêng Microsoft Người ta thường biết VBA ngôn ngữ lập trình mở rộng tạo tập hợp lệnh cốt lõi dần mở rộng sở hình thành ứng dụng, từ làm việc trực tiếp với đối tượng có ứng dụng Modules sáng kiến chia làm phần: Phần dành cho TN: Tinh_diem_TN Sub Copysolieu_Tinhdiem liên kết với nút thực thi số  Sheet 4(Sh_01) có nhiệm vụ gọi Sub (thủ tục): CopyLop_UT_KK có nhiệm vụ lấy liệu (lớp, điểm trung bình lớp 12, điểm ưu tiên, khuyến khích) từ Sheet5: KetnoiDL sang Sheet4: Sh_01 Tinh_KHTN_KHXH có nhiệm vụ tính điểm tổ hợp KHTN, KHXH, tính điểm xét tốt nghiệp, xét khả đậu tốt nghiệp Sheet4: Sh_01 Sub Copysolieu_Tinhdiem() Call CopyLop_UT_KK Call Tinh_KHTN_KHXH End Sub Phần dành cho tổ hợp: Tinh_diem_TH Option Explicit Public Sub sSh_01() s_DiemToHop DiemTH_Max TH_Max End Sub Public Sub sSh_01 liên kết với nút thực thi số  Sheet 4(Sh_01) có nhiệm vụ gọi Sub (thủ tục): s_DiemToHop "Điểm Tổ hợp" dùng để tính điểm tổ hợp xét tuyển học sinh đăng kí, ví dụ học sinh đăng kí tổ hợp A00 VBA cộng điểm mơn Tốn, Lý, Hóa DiemTH_Max " Tổ hợp điểm cao có đăng ký": Trong năm gần đây, học sinh đăng kí xét tuyển lần đầu nhiều tổ hợp Năm 2022 phần tuyển sinh Đại học thay đổi nên mục không phát triển TH_Max "Tổ hợp điểm cao bao gồm khơng đăng ký" VBA chạy dị hết tổ hợp, tìm tổ hợp mà học sinh có điểm cao nhất, xuất liệu điểm môn thi liên quan Phần sử dụng biến mảng, thư viện nên cú pháp Option Explicit giúp mã code VBA hoạt động theo cách biến phải khai báo trước sử dụng Phần dành tính điểm trung bình, %: Tinh_phan_tram Sub TINHP_TRAM liên kết với nút thực thi số  Sheet 3(Baocaoso) có nhiệm vụ gọi Sub (thủ tục): Sub TINHP_TRAM() Call DEM_Toan Call DEM_Van Call DEM_T_anh Call DEM_Vly Call DEM_Hoah Call DEM_Sinhh Call DEM_Lsu Call DEM_Dly Call DEM_GDCD Call Tbmon Call Dinhdang Call laytieude Call demcaclop Sheet3.Select Cells(1, 1).Select End Sub Các thủ tục tính tốn từ liệu sheet4, xuất số lượng thí sinh thi mơn, phân loại điểm, % loại Đặc biệt điểm trung bình toàn trường (= tổng số điểm thi/tổng số thi) Một giá trị dùng để so sánh, xếp thứ hạng trường THPT Tỉnh Phần báo cáo Ban giám hiệu sử dụng công thức Excel để tính 2.3.1.3 Viết code cho thủ tục Tất chương trình VBA phải bắt đầu "Sub" kết thúc "End sub" Ở tên tên bạn muốn gán cho chương trình bạn - Sub name() - End Sub Workbook worksheet opject: đề cập phạm vi áp dụng lệnh VBA toàn workbook hay worksheet Range opject: đại diện đối tượng bảng tính bạn, đối tượng quan trọng VBA Excel Variables: loại biến If then Statements: hàm so sánh điều kiện Loop: Vòng lặp – cho phép lặp lại thao tác phạm vi Userform: nút bấm, box nhập liệu,…dùng để thiết kế giao diện Events: kiện Excel hành động người dùng, dùng code để thực thao tác sau có kiện sẵn Function & sub: function trả giá trị cịn sub khơng trả giá trị Trong mục tơi xin trình bày code Sub dùng để tính điểm tổ hợp KHTN, KHXT, điểm trung bình xét tốt nghiệp xét thử học sinh có đậu tốt nghiệp khơng Cịn code sub khác trình bày phần phụ lục Sub Tinh_KHTN_KHXH() 'Xác định stt dòng liệu cuối jjj = Sheet4.Cells(Rows.Count, 1).End(xlUp).row 'Chọn sheet4 để làm việc Sheet4.Select 'Xóa liệu cột điểm KHTN, KHXH, điểm tbm, xét thử đậu tốt nghiệp range(Cells(3, 28), Cells(jjj, 29)).ClearContents range(Cells(3, 18), Cells(jjj, 19)).ClearContents 'Khai báo biến i Dim i As Integer 'Vòng lặp i chạy từ đến dòng cuối For i = To jjj 'Điều kiện chạy học sinh đủ thi If Application.WorksheetFunction.Count(Cells(i, 9), Cells(i, 10), Cells(i, 11), Cells(i, 12), Cells(i, 13), Cells(i, 14)) = Then tam1 = (Cells(i, 12) + Cells(i, 13) + Cells(i, 14)) / 'Tính điểm thi KHTN Cells(i, 18).Value = Application.WorksheetFunction.Round(tam1, 2) 'Tính điểm Tb để xét đậu TN, theo công thức Bộ GD&ĐT tamt1 = ((7 * ((Cells(i, 9) + Cells(i, 10) + Cells(i, 11) + tam1 + Cells(i, 26)) / 4) + * Cells(i, 25)) / 10) + Cells(i, 27) Cells(i, 28).Value = Application.WorksheetFunction.Round(tamt1, 2) 'Xét điều kiện để đậu TN: Tbm >= khơng có điểm liệt If Application.WorksheetFunction.And(Cells(i, 28) > 4.99999, Application.WorksheetFunction.Min(Cells(i, 9), Cells(i, 10), Cells(i, 11), Cells(i, 12), Cells(i, 13), Cells(i, 14), Cells(i, 15), Cells(i, 16), Cells(i, 17)) > 1.000001) Then Cells(i, 29) = "Ð" End If End If 'Thoát vòng lặp Next i 'Áp dụng tương tự với tổ hợp KHXH Dim j As Integer For j = To jjj If Application.WorksheetFunction.Count(Cells(j, 9), Cells(j, 10), Cells(j, 11), Cells(j, 15), Cells(j, 16), Cells(j, 17)) = Then tam2 = (Cells(j, 15) + Cells(j, 16) + Cells(j, 17)) / Cells(j, 19).Value = Application.WorksheetFunction.Round(tam2, 2) tamt2 = ((7 * ((Cells(j, 9) + Cells(j, 10) + Cells(j, 11) + tam2 + Cells(j, 26)) / 4) + * Cells(j, 25)) / 10) + Cells(j, 27) Cells(j, 28).Value = Application.WorksheetFunction.Round(tamt2, 2) If Application.WorksheetFunction.And(Cells(j, 28) > 4.99999, Application.WorksheetFunction.Min(Cells(j, 9), Cells(j, 10), Cells(j, 11), Cells(j, 12), Cells(j, 13), Cells(j, 14), Cells(j, 15), Cells(j, 16), Cells(j, 17)) > 1.000001) Then Cells(j, 29) = "Ð" End If End If Next j End Sub Dim I As Integer For I = To jjj If Application.WorksheetFunction.Count(Cells(I, 9), Cells(I, 10), Cells(I, 11), Cells(I, 12), Cells(I, 13), Cells(I, 14)) = Then tam1 = (Cells(I, 12) + Cells(I, 13) + Cells(I, 14)) / 'Tinh KHTN Cells(I, 18).Value = Application.WorksheetFunction.Round(tam1, 2) 'Tinh DXTN tamt1 = ((7 * ((Cells(I, 9) + Cells(I, 10) + Cells(I, 11) + tam1 + Cells(I, 26)) / 4) + * Cells(I, 25)) / 10) + Cells(I, 27) Cells(I, 28).Value = Application.WorksheetFunction.Round(tamt1, 2) 'Tinh diem TB cac mon va xet TN If Application.WorksheetFunction.And(Cells(I, 28) > 4.99999, Application.WorksheetFunction.Min(Cells(I, 9), Cells(I, 10), Cells(I, 11), Cells(I, 12), Cells(I, 13), Cells(I, 14), Cells(I, 15), Cells(I, 16), Cells(I, 17)) > 1.000001) Then Cells(I, 29) = "Ð" End If End If Next I Dim J As Integer For J = To jjj If Application.WorksheetFunction.Count(Cells(J, 9), Cells(J, 10), Cells(J, 11), Cells(J, 15), Cells(J, 16), Cells(J, 17)) = Then tam2 = (Cells(J, 15) + Cells(J, 16) + Cells(J, 17)) / 'Tinh KHXH Cells(J, 19).Value = Application.WorksheetFunction.Round(tam2, 2) tamt2 = ((7 * ((Cells(J, 9) + Cells(J, 10) + Cells(J, 11) + tam2 + Cells(J, 26)) / 4) + * Cells(J, 25)) / 10) + Cells(J, 27) Cells(J, 28).Value = Application.WorksheetFunction.Round(tamt2, 2) If Application.WorksheetFunction.And(Cells(J, 28) > 4.99999, Application.WorksheetFunction.Min(Cells(J, 9), Cells(J, 10), Cells(J, 11), Cells(J, 12), Cells(J, 13), Cells(J, 14), Cells(J, 15), Cells(J, 16), Cells(J, 17)) > 1.000001) Then Cells(J, 29) = "Ð" End If End If Next J End Sub Sub Copy_bangmoi() T = Sheet4.Cells(Rows.Count, 1).End(xlUp).row 'COPY MANG DANH SACH Sheets("Sh_01").Select range(Cells(2, 1), Cells(T, 4)).Select Selection.Copy Sheets("Chung (VL)").Select range("A4").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False 'COPY MANG DIEM SO Sheets("Sh_01").Select range(Cells(2, 9), Cells(T, 17)).Select 16 Selection.Copy Sheets("Chung (VL)").Select range("H4").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False 'COPY MANG XET TN Sheets("Sh_01").Select range(Cells(2, 28), Cells(T, 29)).Select Selection.Copy Sheets("Chung (VL)").Select range("Q4").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False 'COPY MANG XET TO HOP Sheets("Sh_01").Select range(Cells(2, 22), Cells(T, 23)).Select Selection.Copy Sheets("Chung (VL)").Select range("S4").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False '================================================== 'COPY TIEU DE Sheets("KetnoiDL").Select range(Cells(1, 3), Cells(1, 5)).Select Selection.Copy Sheets("Chung (VL)").Select range("E4").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Dim arr As Variant Dim I As Integer Dim J As Integer T = Sheet4.Cells(Rows.Count, 1).End(xlUp).row - arr = Sheet5.range("A2:K" & T + 1).Value For J = To T For I = To T + If Sheet2.Cells(I, 3) = arr(J, 1) Then Sheet2.Cells(I, 5) = arr(J, 3) Sheet2.Cells(I, 6) = arr(J, 4) Sheet2.Cells(I, 7) = arr(J, 5) End If Next I Next J End Sub 'Sap xep theo yeu cau Sub SX_TN() 17 Sheets("Chung (VL)").Select range("B5", range("T" & Rows.Count).End(xlUp)).Sort [Q5], xlDescending End Sub Sub SX_TH() Sheets("Chung (VL)").Select range("B5", range("T" & Rows.Count).End(xlUp)).Sort [S5], xlDescending End Sub Sub SX_LOP() T = Sheet4.Cells(Rows.Count, 1).End(xlUp).row + Sheets("Chung (VL)").Select range("B5", range("T" & T)).Sort [B5], xlAscending Sheets("Chung (VL)").Select range("B5", range("T" & T)).Sort [F5], xlAscending End Sub Sub SX_SBD() T = Sheet4.Cells(Rows.Count, 1).End(xlUp).row + Sheets("Chung (VL)").Select range("B5", range("T" & T)).Sort [B5], xlAscending End Sub Code thực thi cơng việc: - Tính điểm theo tổ hợp đăng ký - Tính điểm lớn tổ hợp đăng ký - Tính điểm tổ hợp cao có Option Explicit Public Sub sSh_01() s_DiemToHop DiemTH_Max TH_Max End Sub Public Sub s_DiemToHop() Dim dic As Object, sArr(), dArr(), MATH As String Dim I As Long, J As Long, R As Long Set dic = CreateObject("Scripting.Dictionary") sArr = Sheets("Cactohop").range("A2", Sheets("Cactohop").range("A3").End(xlDown)).Resize(, 13).Value R = UBound(sArr) For I = To R For J = To 13 If sArr(I, J) > Then dic.Item(sArr(I, 1)) = dic.Item(sArr(I, 1)) & "#" & sArr(1, J) & "$" End If Next J Next I '====================================================' With Sheets("Sh_01") sArr = range("G2", range("G100000").End(xlUp)).Resize(, 13).Value R = UBound(sArr) ReDim dArr(1 To R - 1, To 1) For I = To R If sArr(I, 1) Empty Then If dic.exists(sArr(I, 1)) Then 18 MATH = dic.Item(sArr(I, 1)) For J = To 13 If InStr(MATH, "#" & sArr(1, J) & "$") Then dArr(I - 1, 1) = dArr(I - 1, 1) + sArr(I, J) End If Next J End If End If Next I range("T3").Resize(R - 1) = dArr End With Set dic = Nothing End Sub Public Sub DiemTH_Max() Dim dic As Object, sArr(), dArr(), I As Long, R As Long, Rws As Long, Txt As String Set dic = CreateObject("Scripting.Dictionary") sArr = Sheets("Sh_01").range("B3", range("B3").End(xlDown)).Resize(, 19).Value Rws = UBound(sArr) ReDim dArr(1 To Rws, To 1) For I = To Rws Txt = sArr(I, 1) If Not dic.exists(Txt) Then dic.Item(Txt) = I dArr(I, 1) = sArr(I, 19) Else R = dic.Item(Txt) If dArr(R, 1) < sArr(I, 19) Then dArr(R, 1) = sArr(I, 19) End If Next I range("U3").Resize(Rws) = dArr Set dic = Nothing End Sub Public Sub TH_Max() Dim sArr(), dArr(), tArr(), DiemMax As Double, MATH As String Dim I As Long, J As Long, N As Long, R1 As Long, R2 As Long tArr = Sheets("Cactohop").range("A2", Sheets("Cactohop").range("A3").End(xlDown)).Resize(, 13).Value R1 = UBound(tArr) '=========================================================' With Sheets("Sh_01") sArr = range("G3", range("G100000").End(xlUp)).Resize(, 13).Value R2 = UBound(sArr) ReDim dArr(1 To R2, To 3) For I = To R2 If sArr(I, 1) Empty Then For N = To R1 DiemMax = For J = To 13 If tArr(N, J) = Then 'DiemMax = DiemMax + sArr(I, J) DiemMax = DiemMax + VBA.Val(sArr(I, J)) End If 19 Next J If DiemMax > dArr(I, 1) Then dArr(I, 1) = DiemMax dArr(I, 2) = tArr(N, 1) dArr(I, 3) = tArr(N, 2) End If Next N End If Next I range("V3").Resize(R2, 3) = dArr End With End Sub Code thực thi công việc: - Tính số điểm mơn, Tb tồn trường, tỉ lệ % (theo mẫu Phịng KT&KĐCLGD) - Tính điểm Tb môn lớp Sub TINHP_TRAM() Call DEM_Toan Call DEM_Van Call DEM_T_anh Call DEM_Vly Call DEM_Hoah Call DEM_Sinhh Call DEM_Lsu Call DEM_Dly Call DEM_GDCD Call Tbmon Call Dinhdang Call laytieude Call demcaclop Sheet3.Select Cells(1, 1).Select End Sub Sub DEM_Toan() Sheet3.range(Cells(4, 1), Cells(4, 13)).ClearContents Sheet3.Cells(13, 13).ClearContents Dim aToan As Variant Sheets("Sh_01").Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row jjj = Application.WorksheetFunction.Count(range(Cells(3, 9), Cells(ttt, 9))) aToan = Sheet4.range(Cells(3, 9), Cells(ttt, 9)).Value xToan0 = Application.WorksheetFunction.CountBlank(Sheet4.range(Cells(3, 9), Cells(ttt, 9))) Dim I As Integer Sheet3.Cells(4, 2) = jjj Sheet3.Cells(4, 1) = Sheet4.Cells(2, 9) xToan1 = xToan2 = xToan3 = xToan4 = xToan5 = 20 For I = To ttt - If aToan(I, 1) = Then xToan5 = xToan5 + End If Sheet3.Cells(4, 11) = xToan5 Sheet3.Cells(4, 12) = Sheet3.Cells(4, 11) / Sheet3.Cells(4, 2) Sheet3.Select Next I Sheet3.Select Set ObjEDR = Nothing End Sub Sub DEM_Van() Sheet3.range(Cells(5, 1), Cells(5, 13)).ClearContents Sheet3.Cells(13, 13).ClearContents Dim aVan As Variant Sheets("Sh_01").Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row jjj = Application.WorksheetFunction.Count(range(Cells(3, 10), Cells(ttt, 10))) aVan = Sheet4.range(Cells(3, 10), Cells(ttt, 10)).Value xVan0 = Application.WorksheetFunction.CountBlank(Sheet4.range(Cells(3, 10), Cells(ttt, 10))) Dim I As Integer Sheet3.Cells(5, 2) = jjj Sheet3.Cells(5, 1) = Sheet4.Cells(2, 10) xVan1 = xVan2 = xVan3 = xVan4 = xVan5 = For I = To ttt - If aVan(I, 1) = Then xVan5 = xVan5 + End If Sheet3.Cells(5, 11) = xVan5 Sheet3.Cells(5, 12) = Sheet3.Cells(5, 11) / Sheet3.Cells(5, 2) Sheet3.Select Next I Sheet3.Select Set ObjEDR = Nothing End Sub Sub DEM_T_anh() Sheet3.range(Cells(6, 1), Cells(6, 13)).ClearContents Sheet3.Cells(13, 13).ClearContents Dim aT_anh As Variant Sheets("Sh_01").Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row jjj = Application.WorksheetFunction.Count(range(Cells(3, 11), Cells(ttt, 11))) aT_anh = Sheet4.range(Cells(3, 11), Cells(ttt, 11)).Value xT_anh0 = Application.WorksheetFunction.CountBlank(Sheet4.range(Cells(3, 11), Cells(ttt, 11))) Dim I As Integer Sheet3.Cells(6, 2) = jjj Sheet3.Cells(6, 1) = Sheet4.Cells(2, 11) xT_anh1 = xT_anh2 = xT_anh3 = xT_anh4 = xT_anh5 = For I = To ttt - If aT_anh(I, 1) = Then xT_anh5 = xT_anh5 + End If Sheet3.Cells(6, 11) = xT_anh5 Sheet3.Cells(6, 12) = Sheet3.Cells(6, 11) / Sheet3.Cells(6, 2) Sheet3.Select Next I Sheet3.Select Set ObjEDR = Nothing End Sub Sub DEM_Lsu() Sheet3.range(Cells(10, 1), Cells(10, 13)).ClearContents Sheet3.Cells(13, 13).ClearContents Dim aLsu As Variant Sheets("Sh_01").Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row jjj = Application.WorksheetFunction.Count(range(Cells(3, 15), Cells(ttt, 15))) aLsu = Sheet4.range(Cells(3, 15), Cells(ttt, 15)).Value xLsu0 = Application.WorksheetFunction.CountBlank(Sheet4.range(Cells(3, 15), Cells(ttt, 15))) Dim I As Integer Sheet3.Cells(10, 2) = jjj Sheet3.Cells(10, 1) = Sheet4.Cells(2, 15) xLsu1 = xLsu2 = xLsu3 = xLsu4 = xLsu5 = For I = To ttt - If aLsu(I, 1) = Then xLsu5 = xLsu5 + End If Sheet3.Cells(10, 11) = xLsu5 Sheet3.Cells(10, 12) = Sheet3.Cells(10, 11) / Sheet3.Cells(10, 2) Sheet3.Select Next I Sheet3.Select Set ObjEDR = Nothing End Sub Sub DEM_Dly() Sheet3.range(Cells(11, 1), Cells(11, 13)).ClearContents Sheet3.Cells(13, 13).ClearContents Dim aDly As Variant Sheets("Sh_01").Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row jjj = Application.WorksheetFunction.Count(range(Cells(3, 16), Cells(ttt, 16))) aDly = Sheet4.range(Cells(3, 16), Cells(ttt, 16)).Value xDly0 = Application.WorksheetFunction.CountBlank(Sheet4.range(Cells(3, 16), Cells(ttt, 16))) Dim I As Integer Sheet3.Cells(11, 2) = jjj Sheet3.Cells(11, 1) = Sheet4.Cells(2, 16) xDly1 = xDly2 = xDly3 = xDly4 = xDly5 = For I = To ttt - If aDly(I, 1) = Then xDly5 = xDly5 + End If Sheet3.Cells(11, 11) = xDly5 Sheet3.Cells(11, 12) = Sheet3.Cells(11, 11) / Sheet3.Cells(11, 2) Sheet3.Select Next I Sheet3.Select Set ObjEDR = Nothing End Sub Sub DEM_GDCD() Sheet3.range(Cells(12, 1), Cells(12, 13)).ClearContents Sheet3.Cells(13, 13).ClearContents Dim aGDCD As Variant Sheets("Sh_01").Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row jjj = Application.WorksheetFunction.Count(range(Cells(3, 17), Cells(ttt, 17))) aGDCD = Sheet4.range(Cells(3, 17), Cells(ttt, 17)).Value xGDCD0 = Application.WorksheetFunction.CountBlank(Sheet4.range(Cells(3, 17), Cells(ttt, 17))) Dim I As Integer Sheet3.Cells(12, 2) = jjj Sheet3.Cells(12, 1) = Sheet4.Cells(2, 17) xGDCD1 = xGDCD2 = xGDCD3 = xGDCD4 = xGDCD5 = For I = To ttt - If aGDCD(I, 1) = Then xGDCD5 = xGDCD5 + End If Sheet3.Cells(12, 11) = xGDCD5 Sheet3.Cells(12, 12) = Sheet3.Cells(12, 11) / Sheet3.Cells(12, 2) Sheet3.Select Next I Sheet3.Select Set ObjEDR = Nothing End Sub Sub DEM_Vly() Sheet3.range(Cells(7, 1), Cells(7, 13)).ClearContents Sheet3.Cells(13, 13).ClearContents Dim aVly As Variant Sheets("Sh_01").Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row jjj = Application.WorksheetFunction.Count(range(Cells(3, 12), Cells(ttt, 12))) aVly = Sheet4.range(Cells(3, 12), Cells(ttt, 12)).Value xVly0 = Application.WorksheetFunction.CountBlank(Sheet4.range(Cells(3, 12), Cells(ttt, 12))) Dim I As Integer Sheet3.Cells(7, 2) = jjj Sheet3.Cells(7, 1) = Sheet4.Cells(2, 12) xVly1 = xVly2 = xVly3 = xVly4 = xVly5 = For I = To ttt - If aVly(I, 1) = Then xVly5 = xVly5 + End If Sheet3.Cells(7, 11) = xVly5 Sheet3.Cells(7, 12) = Sheet3.Cells(7, 11) / Sheet3.Cells(7, 2) Sheet3.Select Next I Sheet3.Select Set ObjEDR = Nothing End Sub Sub DEM_Hoah() Sheet3.range(Cells(8, 1), Cells(8, 13)).ClearContents Sheet3.Cells(13, 13).ClearContents Dim aHoah As Variant Sheets("Sh_01").Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row jjj = Application.WorksheetFunction.Count(range(Cells(3, 13), Cells(ttt, 13))) aHoah = Sheet4.range(Cells(3, 13), Cells(ttt, 13)).Value xHoah0 = Application.WorksheetFunction.CountBlank(Sheet4.range(Cells(3, 13), Cells(ttt, 13))) Dim I As Integer Sheet3.Cells(8, 2) = jjj Sheet3.Cells(8, 1) = Sheet4.Cells(2, 13) xHoah1 = xHoah2 = xHoah3 = xHoah4 = xHoah5 = For I = To ttt - If aHoah(I, 1) = Then xHoah5 = xHoah5 + End If Sheet3.Cells(8, 11) = xHoah5 Sheet3.Cells(8, 12) = Sheet3.Cells(8, 11) / Sheet3.Cells(8, 2) Sheet3.Select Next I Sheet3.Select Set ObjEDR = Nothing End Sub Sub DEM_Sinhh() Sheet3.range(Cells(9, 1), Cells(9, 13)).ClearContents Sheet3.Cells(13, 13).ClearContents Dim aSinhh As Variant Sheets("Sh_01").Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row jjj = Application.WorksheetFunction.Count(range(Cells(3, 14), Cells(ttt, 14))) aSinhh = Sheet4.range(Cells(3, 14), Cells(ttt, 14)).Value xSinhh0 = Application.WorksheetFunction.CountBlank(Sheet4.range(Cells(3, 14), Cells(ttt, 14))) Dim I As Integer Sheet3.Cells(9, 2) = jjj Sheet3.Cells(9, 1) = Sheet4.Cells(2, 14) xSinhh1 = xSinhh2 = xSinhh3 = xSinhh4 = xSinhh5 = For I = To ttt - If aSinhh(I, 1) = Then xSinhh5 = xSinhh5 + End If 28 Sheet3.Cells(9, 11) = xSinhh5 Sheet3.Cells(9, 12) = Sheet3.Cells(9, 11) / Sheet3.Cells(9, 2) Sheet3.Select Next I Sheet3.Select Set ObjEDR = Nothing End Sub Sub Tbmon() Sheet4.Select ttt = Sheet4.Cells(Rows.Count, 1).End(xlUp).row Sheet3.Cells(4, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("I3:I" & ttt)), 2) Sheet3.Cells(5, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("J3:J" & ttt)), 2) Sheet3.Cells(6, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("K3:K" & ttt)), 2) Sheet3.Cells(7, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("L3:L" & ttt)), 2) Sheet3.Cells(8, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("M3:M" & ttt)), 2) Sheet3.Cells(9, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("N3:N" & ttt)), 2) Sheet3.Cells(10, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("O3:O" & ttt)), 2) Sheet3.Cells(11, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("P3:P" & ttt)), 2) Sheet3.Cells(12, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("Q3:Q" & ttt)), 2) Sheet3.Cells(13, 13) Application.WorksheetFunction.Round(Application.WorksheetFunction.Average(Sheet4.range("I3:Q" & ttt)), 2) Sheet3.Select Cells(1, 1).Select End Sub Sub Dinhdang() Sheet3.Select Dim I As Integer Dim J As Integer Dim rng As range Dim WorkRng As range On Error Resume Next For I = To 12 Step For J = To 12 Step Set WorkRng = Cells(I, J) For Each rng In WorkRng 'Lam tron so rng.Value = Application.WorksheetFunction.Round(rng.Value, 4) Next Cells(I, J).NumberFormat = "0.00%" Next J Next I End Sub 29 = = = = = = = = = = Sub demcaclop() range("B18:J30").ClearContents Dim T As Integer 'Bien Dong ' Dim I As Integer 'Bien Cot ' Dim J As Integer Dim WF As Object, Sh As Worksheet: On Error GoTo LoiCT Set Sh = Sheet4: Sh.Select T = Sh.Cells(Rows.Count, 1).End(xlUp).row Set WF = Application.WorksheetFunction For J = 18 To 29 For I = To 10 ' On Error Resume Next ' Sheet3.Cells(J, I) = _ WF.Round(WF.AverageIf(Sh.range(Cells(3, 30), Cells(T, 30)), Sheet3.Cells(J, 1), Sh.range(Cells(3, I + 7), Cells(T, I + 7))), 2) Next I Next J Sheet3.Select Err_: Exit Sub LoiCT: If Err = 1004 Then Resume Next Else MsgBox Error, , Err: GoTo Err_ End If End Sub Sub laytieude() Dim I As Integer Dim J As Integer For I = To Cells(16, I + 1) = Cells(I + 3, 1).Value Next I For J = To Cells(17, J + 1) = Cells(J + 3, 13).Value Next J End Sub 30 ... xét tuyển tối ưu Tôi xin đưa sáng kiến kinh nghiệm: “SỬ DỤNG VBA TRONG EXCEL ĐỂ LẬP BÁO CÁO KẾT QUẢ THI VÀ TƯ VẤN TỔ HỢP XÉT TUYỂN CHO HỌC SINH? ?? 1.2 Mục đích nghiên cứu Sự phát triển công nghệ... 02, ) để nhận biết tổ hợp Có 185 tổ hợp Việc sử dụng VBA Excel tính nhanh kết điểm tổ hợp xét tuyển học sinh, từ học sinh đưa phương án ôn tập tốt nhất, đạt hiệu cao xét tuyển 1.3 Đối tư? ??ng nghiên... chia sẻ khó áp dụng Trong công tác tư vấn tổ hợp xét tuyển cho học sinh lớp 12 Các Thầy cô giáo gặp không khó khăn số lượng tổ hợp lớn Điểm tổ hợp lớn nhất, phù hợp với học sinh, tổ hợp gồm mơn