Thống kê điểm THPT 2024 thi theo lớp theo môn thi

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
1050167

1050167

Thành viên mới
Tham gia
16/6/15
Bài viết
27
Được thích
0
Em có file excel đính kèm mọi người có thể giúp đỡ em khi mình click chọn môn thi thì điểm thi môn đó ở tất cả các lớp sẽ được thống kê theo mẫu ở sheet THONG KE không ạ. Em chân thành cảm ơn!
 

File đính kèm

  • SBD TRA CUU DIEM THI.xlsx
    67.1 KB · Đọc: 12
1050167 đã viết:
Em có file excel đính kèm mọi người có thể giúp đỡ em khi mình click chọn môn thi thì điểm thi môn đó ở tất cả các lớp sẽ được thống kê theo mẫu ở sheet THONG KE không ạ. Em chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
.
Với thiêt kế như file này, 11 cột phải dùng 11 công thức khác nhau.

Data Validation trong O2 có 2 môn khác với tiêu đề trong sheet DIEM THI vùng F4:N4, Địa lý <=> Địa lí và GDCD <=>GDCD(Có char(10) ở giữa.

Có thể dùng 1 công thức cho toàn bảng nếu thay đổi thiết kế cũng như nguồn của Data Validation.
 
1050167 đã viết:
Em có file excel đính kèm mọi người có thể giúp đỡ em khi mình click chọn môn thi thì điểm thi môn đó ở tất cả các lớp sẽ được thống kê theo mẫu ở sheet THONG KE không ạ. Em chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Được nhé bạn.Viết cho nó cái code VBA là được.Bạn biết dùng VBA không.
 
1050167 đã viết:
Em có file excel đính kèm mọi người có thể giúp đỡ em khi mình click chọn môn thi thì điểm thi môn đó ở tất cả các lớp sẽ được thống kê theo mẫu ở sheet THONG KE không ạ. Em chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Nếu biết dùng code thử code này.
Mã: 
Sub abc()
    Dim i As Long, arr, dic As Object, dk As String, diem As Integer, T, b As Integer, c As Integer
    Dim j As Integer, so As Integer, lr As Long, data
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("diem thi")
         lr = .Range("E" & Rows.Count).End(xlUp).Row
         If lr < 4 Then Exit Sub
         data = .Range("E4:N" & lr).Value
    End With
    With Sheets("thong ke")
        .Range("C5:T18").ClearContents
        arr = .Range("B3:T18").Value
        For i = 4 To 14
            T = Split(arr(2, i), "-")
            b = T(0) * 10
            c = T(1) * 10
            For j = b To c
                dic.Item(j) = i
            Next j
        Next i
        For i = 3 To 16
            dic.Item(arr(i, 1)) = i
        Next i
        dk = .Range("o2").Value
        For i = 2 To 10
            If data(1, i) = dk Then
               so = i
               Exit For
            End If
        Next i
        If so = 0 Then MsgBox "sai": Exit Sub
        For i = 2 To UBound(data)
            b = dic.Item(data(i, 1))
            If b Then
               arr(b, 2) = arr(b, 2) + 1
               If data(i, so) = Empty Then
                  arr(b, 3) = arr(b, 3) + 1
               Else
               If data(i, so) > 4.9 Then arr(b, 15) = arr(b, 15) + 1
               c = dic.Item(data(i, so) * 10)
               arr(b, c) = arr(b, c) + 1
               If arr(b, 17) <= data(i, so) Then arr(b, 17) = data(i, so)
               If arr(b, 18) = Empty Then
                  arr(b, 18) = data(i, so)
               ElseIf arr(b, 18) >= data(i, so) Then
                   arr(b, 18) = data(i, so)
               End If
                 arr(b, 19) = arr(b, 19) + data(i, so) * 1
               End If
            End If
        Next i
        For i = 3 To 16
            If arr(i, 19) Then arr(i, 19) = arr(i, 19) / (arr(i, 2) - arr(i, 3))
            If arr(i, 15) Then arr(i, 16) = arr(i, 15) / (arr(i, 2) - arr(i, 3))
        Next i
        .Range("B3:T18").Value = arr
    End With
    Set dic = Nothing
End Sub
 

File đính kèm

  • SBD TRA CUU DIEM THI.xlsm
    78.5 KB · Đọc: 5
Cảm ơn bạn nhiều. Cho mình hỏi thêm ạ! Mình thấy cho môn toán là code chạy, giờ cho các môn khác thì sửa code chỗ nào ạ?
Bài đã được tự động gộp:

snow25 đã viết:
Nếu biết dùng code thử code này.
Mã: 
Sub abc()
    Dim i As Long, arr, dic As Object, dk As String, diem As Integer, T, b As Integer, c As Integer
    Dim j As Integer, so As Integer, lr As Long, data
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("diem thi")
         lr = .Range("E" & Rows.Count).End(xlUp).Row
         If lr < 4 Then Exit Sub
         data = .Range("E4:N" & lr).Value
    End With
    With Sheets("thong ke")
        .Range("C5:T18").ClearContents
        arr = .Range("B3:T18").Value
        For i = 4 To 14
            T = Split(arr(2, i), "-")
            b = T(0) * 10
            c = T(1) * 10
            For j = b To c
                dic.Item(j) = i
            Next j
        Next i
        For i = 3 To 16
            dic.Item(arr(i, 1)) = i
        Next i
        dk = .Range("o2").Value
        For i = 2 To 10
            If data(1, i) = dk Then
               so = i
               Exit For
            End If
        Next i
        If so = 0 Then MsgBox "sai": Exit Sub
        For i = 2 To UBound(data)
            b = dic.Item(data(i, 1))
            If b Then
               arr(b, 2) = arr(b, 2) + 1
               If data(i, so) = Empty Then
                  arr(b, 3) = arr(b, 3) + 1
               Else
               If data(i, so) > 4.9 Then arr(b, 15) = arr(b, 15) + 1
               c = dic.Item(data(i, so) * 10)
               arr(b, c) = arr(b, c) + 1
               If arr(b, 17) <= data(i, so) Then arr(b, 17) = data(i, so)
               If arr(b, 18) = Empty Then
                  arr(b, 18) = data(i, so)
               ElseIf arr(b, 18) >= data(i, so) Then
                   arr(b, 18) = data(i, so)
               End If
                 arr(b, 19) = arr(b, 19) + data(i, so) * 1
               End If
            End If
        Next i
        For i = 3 To 16
            If arr(i, 19) Then arr(i, 19) = arr(i, 19) / (arr(i, 2) - arr(i, 3))
            If arr(i, 15) Then arr(i, 16) = arr(i, 15) / (arr(i, 2) - arr(i, 3))
        Next i
        .Range("B3:T18").Value = arr
    End With
    Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều. Cho mình hỏi thêm ạ! Mình thấy cho môn toán là code chạy, giờ cho các môn khác thì sửa code chỗ nào ạ?
 
snow25 đã viết:
Nếu biết dùng code thử code này.
Mã: 
Sub abc()
    Dim i As Long, arr, dic As Object, dk As String, diem As Integer, T, b As Integer, c As Integer
    Dim j As Integer, so As Integer, lr As Long, data
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("diem thi")
         lr = .Range("E" & Rows.Count).End(xlUp).Row
         If lr < 4 Then Exit Sub
         data = .Range("E4:N" & lr).Value
    End With
    With Sheets("thong ke")
        .Range("C5:T18").ClearContents
        arr = .Range("B3:T18").Value
        For i = 4 To 14
            T = Split(arr(2, i), "-")
            b = T(0) * 10
            c = T(1) * 10
            For j = b To c
                dic.Item(j) = i
            Next j
        Next i
        For i = 3 To 16
            dic.Item(arr(i, 1)) = i
        Next i
        dk = .Range("o2").Value
        For i = 2 To 10
            If data(1, i) = dk Then
               so = i
               Exit For
            End If
        Next i
        If so = 0 Then MsgBox "sai": Exit Sub
        For i = 2 To UBound(data)
            b = dic.Item(data(i, 1))
            If b Then
               arr(b, 2) = arr(b, 2) + 1
               If data(i, so) = Empty Then
                  arr(b, 3) = arr(b, 3) + 1
               Else
               If data(i, so) > 4.9 Then arr(b, 15) = arr(b, 15) + 1
               c = dic.Item(data(i, so) * 10)
               arr(b, c) = arr(b, c) + 1
               If arr(b, 17) <= data(i, so) Then arr(b, 17) = data(i, so)
               If arr(b, 18) = Empty Then
                  arr(b, 18) = data(i, so)
               ElseIf arr(b, 18) >= data(i, so) Then
                   arr(b, 18) = data(i, so)
               End If
                 arr(b, 19) = arr(b, 19) + data(i, so) * 1
               End If
            End If
        Next i
        For i = 3 To 16
            If arr(i, 19) Then arr(i, 19) = arr(i, 19) / (arr(i, 2) - arr(i, 3))
            If arr(i, 15) Then arr(i, 16) = arr(i, 15) / (arr(i, 2) - arr(i, 3))
        Next i
        .Range("B3:T18").Value = arr
    End With
    Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Code trên chạy được 2 môn toán và tiếng anh, các môn khác thì bị lỗi như hình nhờ bạn giúp mình tí ạ!1719048282424.png
 

File đính kèm

  • SBD TRA CUU DIEM THI.xlsm
    87.8 KB · Đọc: 1
Lần chỉnh sửa cuối:
1050167 đã viết:
Cảm ơn bạn nhiều. Cho mình hỏi thêm ạ! Mình thấy cho môn toán là code chạy, giờ cho các môn khác thì sửa code chỗ nào ạ?
Bài đã được tự động gộp:


Cảm ơn bạn nhiều. Cho mình hỏi thêm ạ! Mình thấy cho môn toán là code chạy, giờ cho các môn khác thì sửa code chỗ nào ạ?
Nhấp chuột vào đây để mở rộng...
không phải sửa điền dữ liệu vào là chạy mà.
Bài đã được tự động gộp:

1050167 đã viết:
Code trên chạy được 2 môn toán và tiếng anh, các môn khác thì bị lỗi như hình nhờ bạn giúp mình tí ạ!View attachment 301906
Nhấp chuột vào đây để mở rộng...
Gửi dữ liệu lỗi lên xem nào.
 
1050167 đã viết:
Cảm ơn bạn nhiều. Cho mình hỏi thêm ạ! Mình thấy cho môn toán là code chạy, giờ cho các môn khác thì sửa code chỗ nào ạ?
Bài đã được tự động gộp:


Cảm ơn bạn nhiều. Cho mình hỏi thêm ạ! Mình thấy cho môn toán là code chạy, giờ cho các môn khác thì sửa code chỗ nào ạ?
Nhấp chuột vào đây để mở rộng...
Data của bạn hình như chưa có, nên nó bị lỗi sao á
 
1050167 đã viết:
Đây anh! File này có dữ liệu tất cả các môn
Nhấp chuột vào đây để mở rộng...
Bạn thử lại code này.
Mã: 
Sub abc()
    Dim i As Long, arr, dic As Object, dk As String, diem As Integer, T, b As Integer, c As Integer
    Dim j As Integer, so As Integer, lr As Long, data, d As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("diem thi")
         lr = .Range("E" & Rows.Count).End(xlUp).Row
         If lr < 4 Then Exit Sub
         data = .Range("E4:N" & lr).Value
    End With
'
    With Sheets("thong ke")
        .Range("C5:T18").ClearContents
        arr = .Range("B3:T18").Value
        For i = 4 To 14
            T = Split(arr(2, i), "-")
            b = T(0) * 100
            c = T(1) * 100
            For j = b To c
                dic.Item(j) = i
            Next j
        Next i
        For i = 3 To 16
            dic.Item(arr(i, 1)) = i
        Next i
        dk = .Range("o2").Value
        For i = 2 To 10
            If data(1, i) = dk Then
               so = i
               Exit For
            End If
        Next i
        If so = 0 Then MsgBox "sai": Exit Sub
        For i = 2 To UBound(data)
            b = dic.Item(data(i, 1))
            If b Then
               arr(b, 2) = arr(b, 2) + 1
               If data(i, so) = Empty Then
                  arr(b, 3) = arr(b, 3) + 1
               Else
               If data(i, so) > 4.9 Then arr(b, 15) = arr(b, 15) + 1
               d = data(i, so) * 100
               c = dic.Item(d)
               arr(b, c) = arr(b, c) + 1
               If arr(b, 17) <= data(i, so) Then arr(b, 17) = data(i, so)
               If arr(b, 18) = Empty Then
                  arr(b, 18) = data(i, so)
               ElseIf arr(b, 18) >= data(i, so) Then
                   arr(b, 18) = data(i, so)
               End If
                 arr(b, 19) = arr(b, 19) + data(i, so) * 1
               End If
            End If
        Next i
        For i = 3 To 16
            If arr(i, 19) Then arr(i, 19) = arr(i, 19) / (arr(i, 2) - arr(i, 3))
            If arr(i, 15) Then arr(i, 16) = arr(i, 15) / (arr(i, 2) - arr(i, 3))
        Next i
        .Range("B3:T18").Value = arr
    End With
    Set dic = Nothing
End Sub
 
snow25 đã viết:
Bạn thử lại code này.
Mã: 
Sub abc()
    Dim i As Long, arr, dic As Object, dk As String, diem As Integer, T, b As Integer, c As Integer
    Dim j As Integer, so As Integer, lr As Long, data, d As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("diem thi")
         lr = .Range("E" & Rows.Count).End(xlUp).Row
         If lr < 4 Then Exit Sub
         data = .Range("E4:N" & lr).Value
    End With
'
    With Sheets("thong ke")
        .Range("C5:T18").ClearContents
        arr = .Range("B3:T18").Value
        For i = 4 To 14
            T = Split(arr(2, i), "-")
            b = T(0) * 100
            c = T(1) * 100
            For j = b To c
                dic.Item(j) = i
            Next j
        Next i
        For i = 3 To 16
            dic.Item(arr(i, 1)) = i
        Next i
        dk = .Range("o2").Value
        For i = 2 To 10
            If data(1, i) = dk Then
               so = i
               Exit For
            End If
        Next i
        If so = 0 Then MsgBox "sai": Exit Sub
        For i = 2 To UBound(data)
            b = dic.Item(data(i, 1))
            If b Then
               arr(b, 2) = arr(b, 2) + 1
               If data(i, so) = Empty Then
                  arr(b, 3) = arr(b, 3) + 1
               Else
               If data(i, so) > 4.9 Then arr(b, 15) = arr(b, 15) + 1
               d = data(i, so) * 100
               c = dic.Item(d)
               arr(b, c) = arr(b, c) + 1
               If arr(b, 17) <= data(i, so) Then arr(b, 17) = data(i, so)
               If arr(b, 18) = Empty Then
                  arr(b, 18) = data(i, so)
               ElseIf arr(b, 18) >= data(i, so) Then
                   arr(b, 18) = data(i, so)
               End If
                 arr(b, 19) = arr(b, 19) + data(i, so) * 1
               End If
            End If
        Next i
        For i = 3 To 16
            If arr(i, 19) Then arr(i, 19) = arr(i, 19) / (arr(i, 2) - arr(i, 3))
            If arr(i, 15) Then arr(i, 16) = arr(i, 15) / (arr(i, 2) - arr(i, 3))
        Next i
        .Range("B3:T18").Value = arr
    End With
    Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh nhiều đã chạy được tất cả các môn.
 
Phuocam đã viết:
.
Với thiêt kế như file này, 11 cột phải dùng 11 công thức khác nhau.

Data Validation trong O2 có 2 môn khác với tiêu đề trong sheet DIEM THI vùng F4:N4, Địa lý <=> Địa lí và GDCD <=>GDCD(Có char(10) ở giữa.

Có thể dùng 1 công thức cho toàn bảng nếu thay đổi thiết kế cũng như nguồn của Data Validation.
Nhấp chuột vào đây để mở rộng...
Cái bảng thiết kế theo dạng báo cáo chứ không phải thống kê. Thớt chưa đủ trình độ lập thống kê.
Kiểu phân tích điểm thế này, người thiết kế bảng phải dựng thế nào để dễ Pivot, Chart,...

Chú: dân thống kê cao cấp còn phải gom tách dữ liệu để phân tích ANOVA,...
 
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

T
  • Question
Giúp em sửa lại code: Lấy duy nhất số phiếu để hiện ra số phiếu tiếp theo
    • Cười
Trả lời
4
Đọc
76
VetMini
V
nghiky
Cách tìm kiếm và lọc số người
Trả lời
7
Đọc
153
nghiky
nghiky
Z
Hỏi về công thức xếp hạng
Trả lời
4
Đọc
559
CHAOQUAY
C
C
Chỉnh sửa VBA đếm thời gian trong excel
Trả lời
13
Đọc
406
thang_nguyen1
T
M
Nhờ anh chị em sửa công thức thứ tự xếp hạng có điều kiện
Trả lời
7
Đọc
72
longtay1111
L
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