Các Thầy/cô giúp em viết code tính tổng điểm các tổ hợp điểm thi Tốt nghiệp, chọn ra tổ hợp có điểm cao nhất. Em xin cảm ơn.

Liên hệ QC
trungtamcnc

trungtamcnc

Thành viên hoạt động
Tham gia
5/4/10
Bài viết
124
Được thích
9
Các Thầy/cô giúp em viết code tính tổng điểm các tổ hợp điểm thi Tốt nghiệp, chọn ra tổ hợp có điểm cao nhất. Bộ GD&ĐT cho rất nhiều loại tổ hợp (A00, C00, D78, D66..) nên việc dò theo cũng rối. Đặc biệt là bên tư vấn và UBND Huyện xin dữ liệu tổ hợp nào của học sinh có điểm cao nhất.
Xin cảm ơn các Thầy/cô rất nhiều. File đính kèm ạ.
 

File đính kèm

  • Xin giup do .xlsx
    21.9 KB · Đọc: 20
trungtamcnc đã viết:
Các Thầy/cô giúp em viết code tính tổng điểm các tổ hợp điểm thi Tốt nghiệp, chọn ra tổ hợp có điểm cao nhất. Bộ GD&ĐT cho rất nhiều loại tổ hợp (A00, C00, D78, D66..) nên việc dò theo cũng rối. Đặc biệt là bên tư vấn và UBND Huyện xin dữ liệu tổ hợp nào của học sinh có điểm cao nhất.
Xin cảm ơn các Thầy/cô rất nhiều. File đính kèm ạ.
Nhấp chuột vào đây để mở rộng...

Có lẽ bạn cần nhập lại tên môn học trong 1 tổ hợp tại cột B đúng theo tên môn học tại C3:M3, làm vậy mới tra cứu được
 

File đính kèm

  • Xin giup do 1.xlsx
    21.9 KB · Đọc: 9
trungtamcnc đã viết:
Các Thầy/cô giúp em viết code tính tổng điểm các tổ hợp điểm thi Tốt nghiệp, chọn ra tổ hợp có điểm cao nhất. Bộ GD&ĐT cho rất nhiều loại tổ hợp (A00, C00, D78, D66..) nên việc dò theo cũng rối. Đặc biệt là bên tư vấn và UBND Huyện xin dữ liệu tổ hợp nào của học sinh có điểm cao nhất.
Xin cảm ơn các Thầy/cô rất nhiều. File đính kèm ạ.
Nhấp chuột vào đây để mở rộng...
Của bạn đây.
Nhưng mình dùng hàm
Nếu bạn cần dùng Code thì chờ Anh/Chị giúp đỡ sau nhé!
Thân!
 

File đính kèm

  • Xin giup do .xlsx
    57 KB · Đọc: 21
trungtamcnc đã viết:
Em đã sửa nhưng chưa có phương án ạ. Cảm ơn Thầy đã quan tâm.
Nhấp chuột vào đây để mở rộng...
Chạy code trong file đính kèm
Nhấn alt + F8 --> chạy tohopDiem
---
Tính tạm tới dòng 18. Chỉ tính các tổ hợp 3 môn
Mã: 
Option Explicit
Option Compare Text

Sub tohopDiem()
Dim TohopBGD
Dim Bangdiem
Dim ThongkeCanhan
Dim Tam, Ten, Diem, Stt
Dim diemMax, tenMax
Dim TohopMon
Dim kq
Dim rws, cls
Dim i, j, k, x, z, t

With Sheet1
    TohopBGD = .Range("A3:B18")
    Bangdiem = .Range("P2:Z20")
    ThongkeCanhan = .Range("AA2:AZ2")
End With
rws = UBound(Bangdiem)
cls = UBound(Bangdiem, 2)
ReDim kq(1 To rws, 1 To UBound(ThongkeCanhan, 2))
With CreateObject("Scripting.Dictionary")
    For j = 3 To UBound(ThongkeCanhan, 2)
        .Item(Application.Trim(ThongkeCanhan(1, j))) = j
    Next j
    For i = 1 To UBound(TohopBGD)
        .Item(Application.Trim(TohopBGD(i, 2))) = .Item(Application.Trim(TohopBGD(i, 1)))
    Next i
     
    For i = 2 To rws
        ReDim Tam(1 To 2, 1 To cls)
        k = 0
     
        For j = 1 To cls
            If Bangdiem(i, j) <> "" Then
                k = k + 1
                Tam(1, k) = Bangdiem(1, j)
                Tam(2, k) = Bangdiem(i, j)
            End If
        Next j
        ReDim Preserve Tam(1 To 2, 1 To k)
           
        lapTohop k, 3, TohopMon
        diemMax = 0
        For x = 0 To UBound(TohopMon)
            Ten = ""
            Diem = 0
         
            For z = 0 To UBound(TohopMon(x))
                Ten = Ten & " " & Tam(1, TohopMon(x)(z) + 1)
                Diem = Diem + Tam(2, TohopMon(x)(z) + 1)
            Next z
            Ten = Trim(Ten)
            If .exists(Ten) Then
                Stt = .Item(Ten)
                kq(i - 1, Stt) = Diem
             
                If diemMax < Diem Then
                    diemMax = Diem
                    tenMax = Ten
                End If
            End If
        Next x
     
        kq(i - 1, 1) = ThongkeCanhan(1, .Item(tenMax))
        kq(i - 1, 2) = diemMax
    Next i
End With
Sheet2.Range("AA3:AZ18").ClearContents
Sheet2.Range("AA3").Resize(UBound(kq), UBound(kq, 2)) = kq
End Sub

Mã: 
Sub lapTohop(ByVal n, ByVal k, kq)
Dim Tam0, Tam1
Dim x, z, t, i, j
ReDim Tam1(k - 1)
With CreateObject("Scripting.Dictionary")
    ReDim Tam0(n - k)
    For x = 0 To n - k
        Tam1(0) = x
        Tam0(x) = Tam1
    Next x
    For t = 1 To k - 1
        For z = 0 To UBound(Tam0)
            For j = Tam0(z)(t - 1) + 1 To n - (k - t)
                Tam1 = Tam0(z)
                Tam1(t) = j
                .Item(.Count) = Tam1
            Next j
        Next z
        Tam0 = .items
        .RemoveAll
    Next t
    kq = Tam0
End With
End Sub
 

File đính kèm

  • Xin giup do 1.xlsb
    34.9 KB · Đọc: 8
trungtamcnc đã viết:
viết code tính tổng điểm các tổ hợp điểm thi Tốt nghiệp, chọn ra tổ hợp có điểm cao nhất. Bộ GD&ĐT cho rất nhiều loại tổ hợp (A00, C00, D78, D66..) nên việc dò theo cũng rối. Đặc biệt là bên tư vấn và UBND Huyện xin dữ liệu tổ hợp nào của học sinh có điểm cao nhất.
Nhấp chuột vào đây để mở rộng...

Bạn xem file đính kèm.
Một cách xử lý khác. Không cần nhập dòng tiêu đề các mã tổ hợp, code sẽ tự động điền thêm nếu có thêm mã tổ hợp mới và có thiết lập giá trị cho mã.
Hiện tại mã tổ hợp nào chưa thiết lập sẽ không hiển thị.


Mã: 
Sub TongHop()
    
    Dim sht As Worksheet, rDiem As Range
    Dim arrToHop, arrDiem, arrMon, arrKQ
    Dim dicToHop As New Dictionary
    Dim lr&, lc&, i&, k&, j&, sToHopMax$, sMon$, Diem As Double, DiemMax As Double
    
    Set sht = Sheets("Chung")
    lr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    
    arrToHop = sht.Range("A3:M" & lr)
    For i = 1 To UBound(arrToHop)
        sMon = ""
        For k = 3 To 13
            If arrToHop(i, k) = 1 Then
                sMon = sMon & k - 2 & ","   'tru lui 2 cot dau
            End If
        Next k
        If sMon = "" Then GoTo skipTohop
        sMon = Left(sMon, Len(sMon) - 1)
        dicToHop.Add arrToHop(i, 1), sMon
skipTohop:
    Next i
    
    lr = sht.Cells(sht.Rows.Count, "O").End(xlUp).Row
    Set rDiem = sht.Range("P3:Z" & lr)
    arrDiem = rDiem
    ReDim arrKQ(UBound(arrDiem) + 1, dicToHop.Count + 2) '+ 2 cot: Tohop Max, Tong Diem Max
    
    '//Gan dong tieu de
    arrKQ(1, 0) = "T" & ChrW(7893) & " h" & ChrW(7907) & "p Max"
    arrKQ(1, 1) = ChrW(272) & ChrW(7875) & "m t" & ChrW(7893) & " h" & ChrW(7907) & "p Max"
    For i = 0 To dicToHop.Count - 1
        arrKQ(1, i + 2) = dicToHop.Keys()(i)
    Next i
    
    '//Diem
    For i = 2 To UBound(arrKQ)
        DiemMax = 0: sToHopMax = ""
        For j = 0 To dicToHop.Count - 1
            arrMon = Split(dicToHop.Items()(j), ",")    'ham Split tao array start 0
            Diem = 0
            For k = 0 To UBound(arrMon)
                Diem = Diem + arrDiem(i - 1, arrMon(k))
            Next k
            arrKQ(i, j + 2) = Diem
            If Diem > DiemMax Then
                DiemMax = Diem
                sToHopMax = dicToHop.Keys()(j)
            End If
        Next j
        arrKQ(i, 0) = sToHopMax
        arrKQ(i, 1) = DiemMax
    Next i
    
    sht.Range("AA1:CC" & lr).ClearContents
    sht.Range("AA1").Resize(UBound(arrKQ, 1) + 1, UBound(arrKQ, 2)).Value = arrKQ
    
    Erase arrToHop
    Erase arrKQ
    Erase arrMon
    Erase arrDiem
    Set dicToHop = Nothing
    
End Sub
 

File đính kèm

  • ToHopDiemThi.xlsb
    28.2 KB · Đọc: 8
ongke0711 đã viết:
Bạn xem file đính kèm.
Một cách xử lý khác. Không cần nhập dòng tiêu đề các mã tổ hợp, code sẽ tự động điền thêm nếu có thêm mã tổ hợp mới và có thiết lập giá trị cho mã.
Hiện tại mã tổ hợp nào chưa thiết lập sẽ không hiển thị.


Mã: 
Sub TongHop()
   
    Dim sht As Worksheet, rDiem As Range
    Dim arrToHop, arrDiem, arrMon, arrKQ
    Dim dicToHop As New Dictionary
    Dim lr&, lc&, i&, k&, j&, sToHopMax$, sMon$, Diem As Double, DiemMax As Double
   
    Set sht = Sheets("Chung")
    lr = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
   
    arrToHop = sht.Range("A3:M" & lr)
    For i = 1 To UBound(arrToHop)
        sMon = ""
        For k = 3 To 13
            If arrToHop(i, k) = 1 Then
                sMon = sMon & k - 2 & ","   'tru lui 2 cot dau
            End If
        Next k
        If sMon = "" Then GoTo skipTohop
        sMon = Left(sMon, Len(sMon) - 1)
        dicToHop.Add arrToHop(i, 1), sMon
skipTohop:
    Next i
   
    lr = sht.Cells(sht.Rows.Count, "O").End(xlUp).Row
    Set rDiem = sht.Range("P3:Z" & lr)
    arrDiem = rDiem
    ReDim arrKQ(UBound(arrDiem) + 1, dicToHop.Count + 2) '+ 2 cot: Tohop Max, Tong Diem Max
   
    '//Gan dong tieu de
    arrKQ(1, 0) = "T" & ChrW(7893) & " h" & ChrW(7907) & "p Max"
    arrKQ(1, 1) = ChrW(272) & ChrW(7875) & "m t" & ChrW(7893) & " h" & ChrW(7907) & "p Max"
    For i = 0 To dicToHop.Count - 1
        arrKQ(1, i + 2) = dicToHop.Keys()(i)
    Next i
   
    '//Diem
    For i = 2 To UBound(arrKQ)
        DiemMax = 0: sToHopMax = ""
        For j = 0 To dicToHop.Count - 1
            arrMon = Split(dicToHop.Items()(j), ",")    'ham Split tao array start 0
            Diem = 0
            For k = 0 To UBound(arrMon)
                Diem = Diem + arrDiem(i - 1, arrMon(k))
            Next k
            arrKQ(i, j + 2) = Diem
            If Diem > DiemMax Then
                DiemMax = Diem
                sToHopMax = dicToHop.Keys()(j)
            End If
        Next j
        arrKQ(i, 0) = sToHopMax
        arrKQ(i, 1) = DiemMax
    Next i
   
    sht.Range("AA1:CC" & lr).ClearContents
    sht.Range("AA1").Resize(UBound(arrKQ, 1) + 1, UBound(arrKQ, 2)).Value = arrKQ
   
    Erase arrToHop
    Erase arrKQ
    Erase arrMon
    Erase arrDiem
    Set dicToHop = Nothing
   
End Sub
Nhấp chuột vào đây để mở rộng...
Thầy giúp em thêm chỗ sẽ không tính điểm tổ hợp nếu không có điểm môn trong tổ hợp với ạ. Em cảm ơn!
 
trungtamcnc đã viết:
Thầy giúp em thêm chỗ sẽ không tính điểm tổ hợp nếu không có điểm môn trong tổ hợp với ạ. Em cảm ơn!
Nhấp chuột vào đây để mở rộng...

Bạn xem file.
Thêm 2 dòng code vô.
Tôi không phải nghề giáo nhé.

Mã: 
For k = 0 To UBound(arrMon)
       If arrDiem(i - 1, arrMon(k)) = 0 Then
           Diem = 0
       Else
           Diem = Diem + arrDiem(i - 1, arrMon(k))
       End If
 Next k
 

File đính kèm

  • ToHopKhoiThi.xlsb
    29.6 KB · Đọc: 7
THÓC SAMA đã viết:
Của bạn đây.
Nhưng mình dùng hàm
Nếu bạn cần dùng Code thì chờ Anh/Chị giúp đỡ sau nhé!
Thân!
Nhấp chuột vào đây để mở rộng...
Dùng hàm thì có 2 phương án:
(Lưu ý: phải điều chỉnh các môn học (các cột E2: O2) đúng và đủ chữ như liệt kê nhóm (tổ hợp) trong bảng "Tổ hợp môn bài" (B3: B26). Vd: phải là "Vật Lý" thay vì "Lí"...)

1/ Nếu thiết kế bảng có liệt kê các tiêu đề nhóm (như cách gọi 'tổ hợp' của chủ thớt), thì dùng:
Mã: 
R3=SUMPRODUCT(COUNTIF(INDEX($B$3:$B$27,MATCH(R$2,$A$3:$A$26,)),"*"&$E$2:$O$2&"*")*$E3:$O3)
Chỉ Enter, rồi fill xuống dưới và các cột phía sau.
Mã: 
P3=INDEX($R$2:$AO$2,,MATCH(Q3,$R3:$AO3,))
Q3=MAX($R3:$AO3)
Enter, fill xuống. (Xem sheet 'Chung (1)')

2/ Nếu thiết kế bảng không cần liệt kê các tiêu đề nhóm, chỉ tổng hợp ra kết quả thôi, thì dùng:
Mã: 
P3=INDEX($A$3:$A$26,MATCH(Q3,MMULT(COUNTIF(OFFSET($B$2,ROW($1:$24),),"*"&$E$2:$O$2&"*")*$E3:$O3,ROW(OFFSET($A$1,,,11))^0),))
Q3=MAX(MMULT(COUNTIF(OFFSET($B$2,ROW($1:$24),),"*"&$E$2:$O$2&"*")*$E3:$O3,ROW(OFFSET($A$1,,,11))^0))
Enter, fill xuống. (Xem sheet 'Chung (2)')

Chú thích:
  1. ROW($1:$24): là số dòng (24 dòng) tương ứng theo B3: B26
  2. ROW(OFFSET($A$1,,,11)) tương ứng với số cột (11 cột) từ E2: O2
Thân
 

File đính kèm

  • Xin giup do .xlsx
    49.5 KB · Đọc: 9
Lần chỉnh sửa cuối:
Phan Thế Hiệp đã viết:
Dùng hàm thì có 2 phương án:
(Lưu ý: phải điều chỉnh các môn học (các cột E2: O2) đúng và đủ chữ như liệt kê nhóm (tổ hợp) trong bảng "Tổ hợp môn bài" (B3: B26). Vd: phải là "Vật Lý" thay vì "Lí"...)

1/ Nếu thiết kế bảng có liệt kê các tiêu đề nhóm (như cách gọi 'tổ hợp' của chủ thớt), thì dùng:
Mã: 
R3=SUMPRODUCT(COUNTIF(INDEX($B$3:$B$27,MATCH(R$2,$A$3:$A$26,)),"*"&$E$2:$O$2&"*")*$E3:$O3)
Chỉ Enter, rồi fill xuống dưới và các cột phía sau.
Mã: 
P3=INDEX($R$2:$AO$2,,MATCH(Q3,$R3:$AO3,))
Q3=MAX($R3:$AO3)
Enter, fill xuống. (Xem sheet 'Chung (1)')

2/ Nếu thiết kế bảng không cần liệt kê các tiêu đề nhóm, chỉ tổng hợp ra kết quả thôi, thì dùng:
Mã: 
P3=INDEX($A$3:$A$26,MATCH(Q3,MMULT(COUNTIF(OFFSET($B$2,ROW($1:$24),),"*"&$E$2:$O$2&"*")*$E3:$O3,ROW(OFFSET($A$1,,,11))^0),))
Q3=MAX(MMULT(COUNTIF(OFFSET($B$2,ROW($1:$24),),"*"&$E$2:$O$2&"*")*$E3:$O3,ROW(OFFSET($A$1,,,11))^0))
Enter, fill xuống. (Xem sheet 'Chung (2)')

Chú thích:
  1. ROW($1:$24): là số dòng (24 dòng) tương ứng theo B3: B26
  2. ROW(OFFSET($A$1,,,11)) tương ứng với số cột (11 cột) từ E2: O2
Thân
Nhấp chuột vào đây để mở rộng...
Vâng, em cám ơn Bác đã góp ý ạ!
Viết xong công thức e thấy dài quá nên có tham khảo mọi người và được Bác Trịnh Bá Ngọc góp ý như sau:
AA3: =OFFSET($AB$2,0,MATCH(AB3,AC3:AR3,0))
AB3: =MAX(AC3:AZ3)
AC3: =IF(COUNTIFS(INDEX($C$3:$M$27,COLUMNS(AC3:$AC3),),">0",$P3:$Z3,"<>")=3,SUMPRODUCT(INDEX($C$3:$M$27,COLUMNS(AC3:$AC3),)*$P3:$Z3),"") Ctrl+Shift+Enter
Em thấy cũng tương đồng với cách giải của Bác!
Xin chân thành cảm ơn Bác!
 

File đính kèm

  • Xin-giup-do-5 (1).xlsx
    34 KB · Đọc: 8
THÓC SAMA đã viết:
Vâng, em cám ơn Bác đã góp ý ạ!
Viết xong công thức e thấy dài quá nên có tham khảo mọi người và được Bác Trịnh Bá Ngọc góp ý như sau:
AA3: =OFFSET($AB$2,0,MATCH(AB3,AC3:AR3,0))
AB3: =MAX(AC3:AZ3)
AC3: =IF(COUNTIFS(INDEX($C$3:$M$27,COLUMNS(AC3:$AC3),),">0",$P3:$Z3,"<>")=3,SUMPRODUCT(INDEX($C$3:$M$27,COLUMNS(AC3:$AC3),)*$P3:$Z3),"") Ctrl+Shift+Enter
Em thấy cũng tương đồng với cách giải của Bác!
Xin chân thành cảm ơn Bác!
Nhấp chuột vào đây để mở rộng...
Không tương đồng giữa 2 công thức:

1/ Công thức của bạn phụ thuộc vào bảng phụ: C3: M27, của tôi thì không cần bảng này.

2/ Công thức của bạn chỉ tính nhóm (tổ hợp) có 'đúng' 3 môn học, của tôi thì không hạn chế. Vd: bạn thử điều chỉnh vào cột B nhóm A00 thêm 'Ngữ văn' và 'Sinh học', cùng số 1 vào cột tương ứng, thì kết quả của bạn cột A00 sẽ bằng 0!? Chưa chính xác.

Thân
 
Phan Thế Hiệp đã viết:
Không tương đồng giữa 2 công thức:

1/ Công thức của bạn phụ thuộc vào bảng phụ: C3: M27, của tôi thì không cần bảng này.

2/ Công thức của bạn chỉ tính nhóm (tổ hợp) có 'đúng' 3 môn học, của tôi thì không hạn chế. Vd: bạn thử điều chỉnh vào cột B nhóm A00 thêm 'Ngữ văn' và 'Sinh học', cùng số 1 vào cột tương ứng, thì kết quả của bạn cột A00 sẽ bằng 0!? Chưa chính xác.

Thân
Nhấp chuột vào đây để mở rộng...
Vâng, em xin tiếp thu góp ý ạ!
Cảm ơn Bác nhiều ạ!
Thân!
 
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

S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
2
Đọc
94
shnhatha221108
S
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2
Trả lời
34
Đọc
309
LuuAnh980
LuuAnh980
trantrimmo
Xin code VBA xuất pdf từ 3 sheet theo lấy thông tin theo tên sheet ạ.
Trả lời
1
Đọc
105
dangvandang
dangvandang
B
  • Question
Chuyển đổi dữ liệu sạng dạng mảng
Trả lời
6
Đọc
109
HieuCD
H
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
6
Đọc
151
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom