snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
Sub BellCurveGrading()
Dim ws As Worksheet
Dim scores As Range
Dim sortedScores As Range
Dim totalStudents As Long
Dim i As Long
Dim grade As String
Dim lastGrade As String
Dim currentScore As Double
Dim nextScore As Double
Dim gradeCount As Long
' ¡Ó˹´ Worksheet áÅЪèǧ¤Ðá¹¹
Set ws = ThisWorkbook.Sheets("Data") ' à»ÅÕ蹪×èÍá¼è¹§Ò¹µÒÁµéͧ¡ÒÃ
Set scores = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
' ¤Ñ´ÅÍ¡áÅÐàÃÕ§ÅӴѺ¤Ðá¹¹
scores.Sort Key1:=scores, Order1:=xlDescending
totalStudents = scores.Count
' ¡Ó˹´à¡Ã´µÒÁ Bell Curve
gradeCount = 0 ' µÑÇá»ÃÊÓËÃѺ¹Ñº¨Ó¹Ç¹¤Ðá¹¹·Õèã¡Åéà¤Õ§¡Ñ¹
For i = 1 To totalStudents
currentScore = ws.Cells(i + 1, 1).Value
' µÃǨÊͺ¤Ðá¹¹·Õè«éӡѹ
If i < totalStudents Then
nextScore = ws.Cells(i + 2, 1).Value
Else
nextScore = currentScore ' ËÒ¡à»ç¹¤Ðá¹¹ÊØ´·éÒÂ
End If
' ¡Ó˹´à¡Ã´
If i <= totalStudents * 0.05 Then
grade = "5"
ElseIf i <= totalStudents * 0.35 Then
grade = "4"
ElseIf i <= totalStudents * 0.75 Then
grade = "3"
ElseIf i <= totalStudents * 0.9 Then
grade = "2"
Else
grade = "1"
End If
' »Ñ´Å§àÁ×èͤÐá¹¹µèÓÊØ´«éÓ
If nextScore = currentScore And grade = "1" Then
grade = "1"
End If
' »Ñ´¢Öé¹àÁ×èͤÐá¹¹ÊÙ§ÊØ´«éÓ
If nextScore = currentScore And grade = "5" Then
grade = "5"
End If
ws.Cells(i + 1, 2).Value = grade ' ãÊèà¡Ã´ã¹¤ÍÅÑÁ¹ì B
Next i
MsgBox "¡ÒõѴà¡Ã´àÊÃç¨ÊÔé¹", vbInformation
End Sub
You do not have the required permissions to view the files attached to this post.