Giúp code lấy điểm tổng kết môn học từ nhiều sheet của tệp A lưu sang 1 sheet tệp B (1 người xem)

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)
T

titanic20072007

Thành viên thường trực
Tham gia
10/7/07
Bài viết
217
Được thích
8
Nghề nghiệp
Giáo viên
Mình có các tệp điểm quản lý điểm các môn học của từng học kỳ. Mỗi tệp gồm nhiều môn, mỗi môn ở 1 sheet có cấu trúc giống nhau. Mình muốn lấy điểm tổng kết và điểm thi 8 tuần và HK (ở hai cột) của từng môn đưa sang một tệp khác theo mẫu cho trước. Mình không biết làm thế nào để khi copy điểm tổng kết của một môn nào đó (tên môn là tên sheet) có thể đưa dữ liệu của môn nào đó vào đúng vị trí cột của môn đấy trong tệp tổng hợp (tệp B). Vậy nhờ các bạn xem giúp. Mình có up tệp dữ liệu, tệp mẫu bảng và tệp để chứa code lấy dữ liệu. Rất mong các bạn giúp, mình đang rất cần. Cảm ơn các bạn.
 

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
sử dụng hàm sumif(cột có tên học sinh ở sheet phụ; cột có tên học sinh ở sheet chính; điểm số tương ứng ở sheet phụ) vào cột điểm từng bộ môn ứng với sheet tương ứng
 
Upvote 0
Cảm bạn đã hướng dẫn. Ý mình muốn dùng code để làm cho nhiều lớp và kết quả là các điểm tổng kết đó phải được đưa ra một tệp có cấu trúc sẵn để dùng cho chương trình khác đọc dữ liệu vào.
 
Upvote 0
titanic20072007 đã viết:
Cảm bạn đã hướng dẫn. Ý mình muốn dùng code để làm cho nhiều lớp và kết quả là các điểm tổng kết đó phải được đưa ra một tệp có cấu trúc sẵn để dùng cho chương trình khác đọc dữ liệu vào.
Nhấp chuột vào đây để mở rộng...
Nếu bạn chịu chỉnh sửa tên sheet từ Tiếng Việt có dấu sang Tiếng Việt không dấu thì mình sẽ có cách giúp bạn.
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Nếu bạn chịu chỉnh sửa tên sheet từ Tiếng Việt có dấu sang Tiếng Việt không dấu thì mình sẽ có cách giúp bạn.
Nhấp chuột vào đây để mở rộng...
Về vấn đề này thì em nghĩ là có bước chuyển đổi từ không dấu sang có dấu, sau khi xử lý xong rồi thì lại chuyển ngược lại từ không dấu sang có dấu, bởi vì tên sheet ở đây do phần mềm xuất ra, và nó có liên quan đến vấn đề Import ngược trở lại phần mềm.
 
Upvote 0
nghiaphuc đã viết:
Về vấn đề này thì em nghĩ là có bước chuyển đổi từ không dấu sang có dấu, sau khi xử lý xong rồi thì lại chuyển ngược lại từ không dấu sang có dấu, bởi vì tên sheet ở đây do phần mềm xuất ra, và nó có liên quan đến vấn đề Import ngược trở lại phần mềm.
Nhấp chuột vào đây để mở rộng...

Thật ra thì nếu dùng TV có dấu cũng được, không cần thiết phải dùng hàm chuyển đổi từ có dấu sang không dấu rồi chuyển đổi ngược lại, rất phiền toái. Thôi thì tùy ý kiến tác giả vậy.
 
Upvote 0
Thôi làm luôn đại, trật hay trúng gì kệ.

[GPECODE=sql]Sub HLMT_ADO()
On Error GoTo Handle
Dim cn As Object, cat As Object, tbl As Object, strTbl As String, i As Integer
Dim mySQL As String, strFile As Variant
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
Set tbl = CreateObject("ADOX.Table")
strFile = Application.GetOpenFilename()
If strFile <> False Then
Application.ScreenUpdating = False
[B7:AV51].ClearContents
With cn
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFile & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
cat.ActiveConnection = cn
For i = 0 To cat.Tables.Count - 1
strTbl = Replace(Replace(cat.Tables(i).Name, "$", ""), "'", "")
Cells(5, i + 3).Value = strTbl
Cells(5, i + 21 + i).Value = strTbl
mySQL = "UPDATE [" & strTbl & "$A6:AH50] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" _
& ThisWorkbook.FullName & "].[HK1$a7:AV51] b " _
& "ON a.F1=b.F1 " _
& "SET b.F2=a.F2, b.F" & i + 3 & "=a.F31, b.F" _
& i + 21 + i & "=a.F33, b.F" & i + 22 + i & "=a.F34"
.Execute mySQL
Next
.Close
End With
Application.ScreenUpdating = True
End If
Set cn = Nothing: Set cat = Nothing: Set tbl = Nothing
Exit Sub
Handle:
MsgBox Err.Description

End Sub

[/GPECODE]
Bạn giải nén, chạy code rồi chọn file cần tổng hợp nhé.
 

File đính kèm

Upvote 0
Cảm ơn bạn Hai Lúa Miền Tây và các bạn đã quân tâm và giúp mình. Mình vừa test thử thì thấy chương trình chạy được rồi. Dữ liệu lấy vào không bị nhầm lẫn giữa các môn. Xong có một vấn đề bạn có thể chỉnh tiếp giúp mình được không?
- Đó là Bạn có thể cập nhật dữ liệu vào đúng cột ở mẫu bảng tổng kết được không. Vì đây là thứ tự môn do chương trình dùng để xếp loại học kỳ qui định rồi giờ cập nhật làm xáo trộn đi sẽ dẫn tới khi import vào chương trình kia nó sẽ hiểu nhầm điểm của môn này với môn khác (rất nguy hiểm do chương trình xếp loại nó căn cứ vào vị trí của cột dữ liệu để đọc tương ứng vào chứ nó không thông minh để có thể nhận biết điểm đang đọc là của môn nào để đưa vào đúng môn trong nó). Về vấn đề VBA mình không được học nên không hiểu cách làm như thế nào nhưng mình thiết nghĩ một giải thuật như thế này bạn xem có được không nhé (có gì đừng cười là không làm được còn lắm chuyện nhé). Tên môn học là cố định trong trường theo mẫu bảng tổng hợp rồi (tuy nhiên với từng khối lại có một số môn không học trong học kỳ đó) nên bạn có thể đọc tên môn học theo thứ tự ở mẫu bảng tổng hợp rồi dò tìm tên sheet nào trong tệp dữ liệu mà trùng với tên môn học đang xét thì đọc dữ liệu vào đúng vị trí cột trong bảng tổng hợp, nếu không tìm thấy có nghĩa là môn học này lớp đó không được học thì bỏ qua chuyển sang cột khác tức là môn khác.
- Bạn có thể chỉnh để code này có thể chạy với bất kỳ lớp nào và với học kỳ nào được không vì mình thử với tệp của lớp khác thì nó không chạy.
Rất mong bạn giúp đỡ, mình đang rất cần để chuẩn bị làm điểm cuối năm. Cảm ơn bạn và các bạn đã quan tâm.
 
Lần chỉnh sửa cuối:
Upvote 0
titanic20072007 đã viết:
Cảm ơn bạn Hai Lúa Miền Tây và các bạn đã quân tâm và giúp mình. Mình vừa test thử thì thấy chương trình chạy được rồi. Dữ liệu lấy vào không bị nhầm lẫn giữa các môn. Xong có một vấn đề bạn có thể chỉnh tiếp giúp mình được không?
- Đó là Bạn có thể cập nhật dữ liệu vào đúng cột ở mẫu bảng tổng kết được không. Vì đây là thứ tự môn do chương trình dùng để xếp loại học kỳ qui định rồi giờ cập nhật làm xáo trộn đi sẽ dẫn tới khi import vào chương trình kia nó sẽ hiểu nhầm điểm của môn này với môn khác (rất nguy hiểm do chương trình xếp loại nó căn cứ vào vị trí của cột dữ liệu để đọc tương ứng vào chứ nó không thông minh để có thể nhận biết điểm đang đọc là của môn nào để đưa vào đúng môn trong nó). Về vấn đề VBA mình không được học nên không hiểu cách làm như thế nào nhưng mình thiết nghĩ một giải thuật như thế này bạn xem có được không nhé (có gì đừng cười là không làm được còn lắm chuyện nhé). Tên môn học là cố định trong trường theo mẫu bảng tổng hợp rồi (tuy nhiên với từng khối lại có một số môn không học trong học kỳ đó) nên bạn có thể đọc tên môn học theo thứ tự ở mẫu bảng tổng hợp rồi dò tìm tên sheet nào trong tệp dữ liệu mà trùng với tên môn học đang xét thì đọc dữ liệu vào đúng vị trí cột trong bảng tổng hợp, nếu không tìm thấy có nghĩa là môn học này lớp đó không được học thì bỏ qua chuyển sang cột khác tức là môn khác.
- Bạn có thể chỉnh để code này có thể chạy với bất kỳ lớp nào và với học kỳ nào được không vì mình thử với tệp của lớp khác thì nó không chạy.
Rất mong bạn giúp đỡ, mình đang rất cần để chuẩn bị làm điểm cuối năm. Cảm ơn bạn và các bạn đã quan tâm.
Nhấp chuột vào đây để mở rộng...

Việc duyệt qua tiêu đề cột của file mẫu theo thứ tự của bạn tôi đã có suy nghĩ đến, thế nhưng do tên cột và tên sheet có khác nhau nên không thể dùng theo cách này. Ví dụ bạn dò và so sánh tên sheet và tên cột của những môn sau đây: Vật lý, Địa lý, Anh văn, GD CD, CN...
 
Upvote 0
Vâng đúng là có một số môn tên sheet và tên môn gõ không thống nhất. Mình đã chỉnh lại tên môn ở mẫu đúng với tên của môn trên nhãn của sheet. Bạn giúp mình tiếp nhé (theo cách duyệt tên môn theo thứ tự trên mẫu). Mình up lại dữ liệu đã chỉnh. Cảm ơn bạn.
 

File đính kèm

Upvote 0
titanic20072007 đã viết:
Vâng đúng là có một số môn tên sheet và tên môn gõ không thống nhất. Mình đã chỉnh lại tên môn ở mẫu đúng với tên của môn trên nhãn của sheet. Bạn giúp mình tiếp nhé (theo cách duyệt tên môn theo thứ tự trên mẫu). Mình up lại dữ liệu đã chỉnh. Cảm ơn bạn.
Nhấp chuột vào đây để mở rộng...
Bạn vẫn chưa chỉnh đầy đủ, thôi thì tôi chỉnh lại những chổ tô màu đỏ.

[GPECODE=sql]Sub HLMT_ADO1()
On Error GoTo Handle
Dim cn As Object, cat As Object, tbl As Object, strTbl As String, i As Integer, iC As Integer
Dim mySQL As String, strFile As Variant
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
Set tbl = CreateObject("ADOX.Table")
strFile = Application.GetOpenFilename()
If strFile <> False Then
Application.ScreenUpdating = False
[B7:AV51].ClearContents
With cn
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFile & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
cat.ActiveConnection = cn
For i = 0 To cat.Tables.Count - 1
strTbl = strTbl & "," & Replace(Replace(cat.Tables(i).Name, "$", ""), "'", "")
Next
For iC = 1 To 13
If InStr(strTbl, Cells(5, iC + 2)) > 0 Then
mySQL = "UPDATE [" & Cells(5, iC + 2) & "$A6:AH50] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" _
& ThisWorkbook.FullName & "].[HK1$a7:AV51] b " _
& "ON a.F1=b.F1 " _
& "SET b.F2=a.F2, b.F" & iC + 2 & "=a.F31, b.F" _
& iC + 19 + iC & "=a.F33, b.F" & iC + 20 + iC & "=a.F34"
.Execute mySQL
End If
Next
.Close
End With
Application.ScreenUpdating = True
End If
Set cn = Nothing: Set cat = Nothing: Set tbl = Nothing
Exit Sub
Handle:
MsgBox Err.Description

End Sub[/GPECODE]
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn bạn mình chạy thử thấy điểm môn này đưa vào cột môn đó trong bảng tổng hợp đúng rồi. Nhưng nếu muốn chạy cho lớp khác thì phải chỉnh thế nào vì mình chạy với lớp khác nó không chạy? Mình muốn chỉ với code này có thể chạy với bat kỳ tệp của lớp nào và học kỳ nào đề được mà không phải tạo mỗi lớp một tệp như thế này (trường mình có nhiều lớp). Phiền bạn xem giúp mình với. Cảm ơn bạn nhiều.
 
Upvote 0
titanic20072007 đã viết:
Cảm ơn bạn mình chạy thử thấy điểm môn này đưa vào cột môn đó trong bảng tổng hợp đúng rồi. Nhưng nếu muốn chạy cho lớp khác thì phải chỉnh thế nào vì mình chạy với lớp khác nó không chạy? Mình muốn chỉ với code này có thể chạy với bat kỳ tệp của lớp nào và học kỳ nào đề được mà không phải tạo mỗi lớp một tệp như thế này (trường mình có nhiều lớp). Phiền bạn xem giúp mình với. Cảm ơn bạn nhiều.
Nhấp chuột vào đây để mở rộng...

Chạy được hết đó bạn, nguyên tắt hoạt động của nó là dựa vào số thứ tự của học sinh để cập nhật dữ liệu qua. Bạn lưu ý là code dòng 25 của bài 11 có đoạn (ThisWorkbook.FullName & "].[HK1$a7:AV51] b) phần tô màu đỏ là tên sheet của file cần cập nhật dữ liệu. Do vậy nếu bạn đổi tên sheet thì phải đổi tên sheet và code cho tương ứng nhé.
 
Upvote 0
Thế nếu mình muốn lấy tên của tệp dữ liệu điểm thì phải dùng lệnh gì? đặt ở chỗ nào? và nếu sau khi tổng hợp mình muốn copy sheet kết quả lưu ra thành một tệp mới thì thêm lệnh gì vào đâu? Bạn chỉ mình với.

Mình đã chỉnh lại code để có thể chạy với bất kỳ lớp; với HK nào cũng được và lưu sheet kết quả ra một tệp riêng được rồi. Nhưng nếu mình ẩn các sheet kết quả bằng thuộc tính Visible = -2 ở tệp chứa code, trong code trước khi update dữ liệu vào tệp sheet kết quả mình có phải bỏ thuộc tính ẩn và sau khi copy sheet đó ra thành tệp mới thì lại phải đặt lại thuộc tính ẩn cho nó. Vậy thì lệnh mở và đóng thuộc tính ẩn của sheet kết quả đặt ở chỗ nào trong code của bạn? Mìnnh đặt thử vào trước lệnh copy nhưng nó lại có tác dụng với sheet ở tệp mới mà không có tác dụng với sheet ở tệp chứa code. Cảm ơn bạn
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
titanic20072007 đã viết:
Thế nếu mình muốn lấy tên của tệp dữ liệu điểm thì phải dùng lệnh gì? đặt ở chỗ nào? và nếu sau khi tổng hợp mình muốn copy sheet kết quả lưu ra thành một tệp mới thì thêm lệnh gì vào đâu? Bạn chỉ mình với.

Mình đã chỉnh lại code để có thể chạy với bất kỳ lớp; với HK nào cũng được và lưu sheet kết quả ra một tệp riêng được rồi. Nhưng nếu mình ẩn các sheet kết quả bằng thuộc tính Visible = -2 ở tệp chứa code, trong code trước khi update dữ liệu vào tệp sheet kết quả mình có phải bỏ thuộc tính ẩn và sau khi copy sheet đó ra thành tệp mới thì lại phải đặt lại thuộc tính ẩn cho nó. Vậy thì lệnh mở và đóng thuộc tính ẩn của sheet kết quả đặt ở chỗ nào trong code của bạn? Mìnnh đặt thử vào trước lệnh copy nhưng nó lại có tác dụng với sheet ở tệp mới mà không có tác dụng với sheet ở tệp chứa code. Cảm ơn bạn
Nhấp chuột vào đây để mở rộng...

Bạn gửi code của bạn lên xem thử nhé
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Bạn gửi code của bạn lên xem thử nhé
Nhấp chuột vào đây để mở rộng...
Mã: 
Option Explicit
Sub CopySheet(hk)
    Application.DisplayAlerts = False
    Sheets(hk).Unprotect Password:=12345
    Sheets(hk).Copy
End Sub
Sub HLMT_ADO1()
    On Error GoTo Handle
    Dim cn As Object, cat As Object, tbl As Object, strTbl As String, i As Integer, iC As Integer, ten, vtri, sohk, hk, tentruong
    Dim mySQL As String, strFile As Variant
    Set cn = CreateObject("ADODB.Connection")
    Set cat = CreateObject("ADOX.Catalog")
    Set tbl = CreateObject("ADOX.Table")
    strFile = Application.GetOpenFilename()
    Workbooks.Open strFile
    sohk = Right(Cells(2, 5), 1)
    tentruong = Cells(1, 1)
    ActiveWindow.Close
    hk = "HK" & sohk
        If strFile <> False Then
            vtri = 0
            For i = 1 To Len(strFile)
                If Mid(strFile, i, 1) = "\" Then vtri = i
            Next
            ten = Right(strFile, Len(strFile) - vtri)
            Sheets(hk).Activate
            Application.ScreenUpdating = False
            [B7:AV51].ClearContents
                 With cn
                      .Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                        "Data Source=" & strFile & _
                                        ";Extended Properties=""Excel 8.0;HDR=No;"";"
                            cat.ActiveConnection = cn
                            For i = 0 To cat.Tables.Count - 1
                                 strTbl = strTbl & "," & Replace(Replace(cat.Tables(i).Name, "$", ""), "'", "")
                            Next
                            For iC = 1 To 14
                                If InStr(strTbl, Cells(5, iC + 2)) > 0 Then
                                    mySQL = "UPDATE [" & Cells(5, iC + 2) & "$A6:AH50] a " _
                                            & "INNER JOIN " _
                                            & "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" _
                                            & ThisWorkbook.FullName & "].[" & hk & "$a7:AV51] b  " _
                                            & "ON a.F1=b.F1 " _
                                            & "SET b.F2=a.F2, b.F" & iC + 2 & "=a.F3" & sohk & ", b.F" _
                                            & iC + 19 + iC & "=a.F33, b.F" & iC + 20 + iC & "=a.F34"
                                    .Execute mySQL
                                 End If
                            Next
                      .Close
                End With
            Application.ScreenUpdating = True
            Call CopySheet(hk)
            Cells(1, 1) = tentruong
            Cells(3, 3) = "Cua tep du lieu ''" & ten & "''"
            [A1:AV55].Locked = True
            Sheets(hk).Protect Password:=12345
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Bang TB cac mon " & ten
            ActiveWindow.Close
            MsgBox "Da ket xuat xong diem TB cac mon " & hk & " cua tep du lieu ''" & ten & "''"
        End If
    Set cn = Nothing: Set cat = Nothing: Set tbl = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
Trong tệp chứa code mình có 3 sheet một sheet chứa nút lệnh chạy code, hai sheet kia chứa hai mẫu bảng tổng hợp điểm ứng với HK1 và HK2. Bạn xem có thể tinh chỉnh giúp mình cho hợp lý hơn và có thể ẩn hai sheet chứa muẫ bảng tổng kết đi để khi sử dụng cho gọn. Cảm ơn bạn.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
titanic20072007 đã viết:
Mã: 
Option Explicit
Sub CopySheet(hk)
    Application.DisplayAlerts = False
    Sheets(hk).Unprotect Password:=12345
    Sheets(hk).Copy
End Sub
Sub HLMT_ADO1()
    On Error GoTo Handle
    Dim cn As Object, cat As Object, tbl As Object, strTbl As String, i As Integer, iC As Integer, ten, vtri, sohk, hk, tentruong
    Dim mySQL As String, strFile As Variant
    Set cn = CreateObject("ADODB.Connection")
    Set cat = CreateObject("ADOX.Catalog")
    Set tbl = CreateObject("ADOX.Table")
    strFile = Application.GetOpenFilename()
    Workbooks.Open strFile
    sohk = Right(Cells(2, 5), 1)
    tentruong = Cells(1, 1)
    ActiveWindow.Close
    hk = "HK" & sohk
        If strFile <> False Then
            vtri = 0
            For i = 1 To Len(strFile)
                If Mid(strFile, i, 1) = "\" Then vtri = i
            Next
            ten = Right(strFile, Len(strFile) - vtri)
            Sheets(hk).Activate
            Application.ScreenUpdating = False
            [B7:AV51].ClearContents
                 With cn
                      .Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                        "Data Source=" & strFile & _
                                        ";Extended Properties=""Excel 8.0;HDR=No;"";"
                            cat.ActiveConnection = cn
                            For i = 0 To cat.Tables.Count - 1
                                 strTbl = strTbl & "," & Replace(Replace(cat.Tables(i).Name, "$", ""), "'", "")
                            Next
                            For iC = 1 To 14
                                If InStr(strTbl, Cells(5, iC + 2)) > 0 Then
                                    mySQL = "UPDATE [" & Cells(5, iC + 2) & "$A6:AH50] a " _
                                            & "INNER JOIN " _
                                            & "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" _
                                            & ThisWorkbook.FullName & "].[" & hk & "$a7:AV51] b  " _
                                            & "ON a.F1=b.F1 " _
                                            & "SET b.F2=a.F2, b.F" & iC + 2 & "=a.F3" & sohk & ", b.F" _
                                            & iC + 19 + iC & "=a.F33, b.F" & iC + 20 + iC & "=a.F34"
                                    .Execute mySQL
                                 End If
                            Next
                      .Close
                End With
            Application.ScreenUpdating = True
            Call CopySheet(hk)
            Cells(1, 1) = tentruong
            Cells(3, 3) = "Cua tep du lieu ''" & ten & "''"
            [A1:AV55].Locked = True
            Sheets(hk).Protect Password:=12345
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Bang TB cac mon " & ten
            ActiveWindow.Close
            MsgBox "Da ket xuat xong diem TB cac mon " & hk & " cua tep du lieu ''" & ten & "''"
        End If
    Set cn = Nothing: Set cat = Nothing: Set tbl = Nothing
    Exit Sub
Handle:
    MsgBox Err.Description
End Sub
Trong tệp chứa code mình có 3 sheet một sheet chứa nút lệnh chạy code, hai sheet kia chứa hai mẫu bảng tổng hợp điểm ứng với HK1 và HK2. Bạn xem có thể tinh chỉnh giúp mình cho hợp lý hơn và có thể ẩn hai sheet chứa muẫ bảng tổng kết đi để khi sử dụng cho gọn. Cảm ơn bạn.
Nhấp chuột vào đây để mở rộng...
Bạn thử code sau coi đúng ý chưa nhé.

[GPECODE=sql]Sub HLMT_ADO1()
On Error GoTo Handle
Dim cn As Object, cat As Object, tbl As Object, strTbl As String, i As Integer, iC As Integer, ten, vtri, sohk, hk, tentruong
Dim mySQL As String, strFile As Variant
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
Set tbl = CreateObject("ADOX.Table")
strFile = Application.GetOpenFilename()
Workbooks.Open strFile
sohk = Right(Cells(2, 5), 1)
tentruong = Cells(1, 1)
ActiveWindow.Close
hk = "HK" & sohk
If strFile <> False Then
vtri = 0
For i = 1 To Len(strFile)
If Mid(strFile, i, 1) = "\" Then vtri = i
Next
ten = Right(strFile, Len(strFile) - vtri)
'MsgBox " ten " & ten
Application.ScreenUpdating = False
Sheets(hk).Visible = xlSheetVisible
Sheets(hk).Activate
[B7:AV51].ClearContents
With cn
.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strFile & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
cat.ActiveConnection = cn
For i = 0 To cat.Tables.Count - 1
strTbl = strTbl & "," & Replace(Replace(cat.Tables(i).Name, "$", ""), "'", "")
Next
For iC = 1 To 14 '13
If InStr(strTbl, Cells(5, iC + 2)) > 0 Then
mySQL = "UPDATE [" & Cells(5, iC + 2) & "$A6:AH50] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=No;IMEX=2;DATABASE=" _
& ThisWorkbook.FullName & "].[" & hk & "$a7:AV51] b " _
& "ON a.F1=b.F1 " _
& "SET b.F2=a.F2, b.F" & iC + 2 & "=a.F3" & sohk & ", b.F" _
& iC + 19 + iC & "=a.F33, b.F" & iC + 20 + iC & "=a.F34"
.Execute mySQL
End If
Next
.Close
End With
Call CopySheet(hk)
Cells(1, 1) = tentruong
Cells(3, 3) = "Cua tep du lieu ''" & ten & "''"
[A1:AV55].Locked = True
Sheets(hk).Protect Password:=12345
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Bang TB cac mon " & ten
ActiveWindow.Close
Sheets(hk).Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
MsgBox "Da ket xuat xong diem TB cac mon " & hk & " cua tep du lieu ''" & ten & "''"
End If
Set cn = Nothing: Set cat = Nothing: Set tbl = Nothing
Exit Sub
Handle:
MsgBox Err.Description
End Sub

[/GPECODE]

Bạn Set thuộc tính của 2 sheet (HK1,HK2) là xlSheetVeryHidden
 
Lần chỉnh sửa cuối:
Upvote 0
Hai lúa Miền Tây ơi bây giờ tệp dữ liệu của mình có một chút thay đổi thế này đó là các môn Thể dục, Âm nhạc, Mỹ Thuật dữ liệu của nó không phải là các số như những môn khác mà là Đ hoặc CĐ. Như vậy thì đoạn code trên không chạy được với các môn này nó báo data type mismatch criteria expression. Bạn có thể chỉnh lại giúp mình không? Cảm ơn bạn. Mình gửi tệp dữ liệu lên bạn chạy và chỉnh hộ mình với.
 

File đính kèm

Upvote 0
Xin lỗi mình xử lý được rồi do mình định dạng các cột đó trong mẫu là số. Cảm ơn bạn
 
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

D
xin hỏi về lỗi mô đun ẩn.
Trả lời
5
Đọc
215
YêuCN
Y
S
  • Question Question
Object.close và Set Object = nothing (2 người xem)
Trả lời
14
Đọc
1K
nguyendang95
N
H
Lỗi khi sort data xin được hỗ trợ
Trả lời
2
Đọc
79
hunglq48
H
Nguyenkhang2404
Tính định mức sản phẩm
    • Chấp nhận
Trả lời
9
Đọc
272
Nguyenkhang2404
Nguyenkhang2404
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
2 3 4
Trả lời
389
Đọc
46K
THANHHANGPT
T
8
Theo dõi bán hàng
Trả lời
6
Đọc
131
Maithy46
Maithy46
T
Ngắt kết nối với tệp lệnh đính kèm
Trả lời
2
Đọc
91
TungXauGiai
T
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
277
Đọc
35K
joker102
J
minhduc1o2
Hình ảnh bị lỗi #VALUE
Trả lời
4
Đọc
96
minhduc1o2
minhduc1o2
S
tỷ lệ % không khớp khi cộng tổng (1 người xem)
Trả lời
2
Đọc
71
snoobcool
S
D
Tên sheet bị che khuất khi thực hiện sửa tên sheet (1 người xem)
Trả lời
1
Đọc
243
PhamMaiTB
P
thanhcongdnk
nhờ các cao nhân giúp dùm, xin đa tạ nhiều
    • Buồn
    • Phẫn nộ
Trả lời
2
Đọc
415
misibi
M
N
  • Question Question
Chia sẻ COM DLL giúp tra cứu mã số thuế từ trang web masothue.com (2 người xem)
    • Thích
Trả lời
1
Đọc
418
nguyendang95
N
hoidebiet1710
Doanh thu cho nhiều nhân viên bán hàng
Trả lời
1
Đọc
109
BuiQuangThuan
B
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
1
Đọc
137
hoidebiet1710
hoidebiet1710
V
  • Question Question
Nhờ mọi người giúp cách xóa các mục đã chọn trong Droplist của một nhóm các ô cùng dạy một môn học. (1 người xem)
Trả lời
3
Đọc
204
HUONGHCKT
H
L
Trừ lùi nguyên vật liệu nhập - xuất - tồn theo nhiều điều kiện
Trả lời
7
Đọc
764
oanhleqt
O
D
Lọc cột chứa nhiều nhóm từ trong Excel. Mong các bạn giải đáp giúp
Trả lời
8
Đọc
214
Thai Huyen
Thai Huyen
T
file excel bị lỗi
Trả lời
1
Đọc
61
BuiQuangThuan
B
dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định
Trả lời
4
Đọc
172
HUONGHCKT
H
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