Office Automation: จัดนักเรียนลงห้องเรียนด้วย Excel VBA

คำถามคือ…ต้องการ จัดนักเรียนลงห้องเรียน ต่างโปรแกรมการเรียนกัน โดยมีเงื่อนไขดังต่อไปนี้…

  • โรงเรียนเปิดโปรแกรมการสอน 4่ โปรแกรมคือ…
    • 1) ห้อง Gifted
    • 2) ห้องวิทย์-คณิต
    • 3) ห้องภาษา
    • 4) ห้องเรียนทั่วไป
  • นักเรียนสามารถเลือกได้ 3 โปรแกรม ตามความถนัด และความสนใจ โดยเรียงลำดับ 1-3 ซึ่งจะถูกใช้เป็นเกณฑ์ในการคัดเลือกเข้าเรียนในแต่ละโปรแกรมด้วย
  • แต่ละห้องรับนักเรียนได้ไม่เท่ากัน
    • ห้อง Gifted รับได้ 30 คน
    • ห้อง วิทย์-คณิต รับได้ 30 คน
    • ห้องภาษา รับได้ 60 คน
    • ห้องเรียนทั่วไป รับได้ 60 คน
    • คัดเอา180 คน จากนักเรียนทั้งหมด 290 คน
  • การ จัดนักเรียนลงห้องเรียน ในแต่ละโปรแกรม มีเกณฑ์คะแนนดังต่อไปนี้
    • ห้อง Gifted ต้องมีคะแนนไม่น้อยกว่า 70 คะแนน
    • ห้อง วิทย์-คณิต ต้องมีคะแนนไม่น้อยกว่า 60 คะแนน
    • ห้องภาษา ต้องมีคะแนนไม่น้อยกว่า 50 คะแนน
    • ห้องเรียนทั่วไป ต้องมีคะแนนไม่น้อยกว่า 40 คะแนน
  • การพิจารณาจะใช้เกณฑ์คะแนน และอันดับที่เลือก (คล้ายการ admission)
  • หากคะแนนเท่ากัน ให้พิจารณาคนที่เลขที่สมัครขึ้นก่อน
  • นักเรียน 1 คน มีได้ 1 ห้องเรียน

ดาวน์โหลดไฟล์ จัดนักเรียนลงห้องเรียน ได้ที่นี่ https://drive.google.com/file/d/1yMDSdQBX6GZ9hj7sINjAdKVxxZ9ivW5g/view?usp=share_link

ออกแบบการทำงานอย่างไร…

  • 1) พิจารณาจากลำดับคะแนนของผู้สมัครจากสูงสุดลงมา
  • 2) หากคะแนนไม่ถึงเกณฑ์ที่กำหนด ให้ตัดออกออกรายชื่อผู้สมัครเลย
  • 3) หากได้จำนวนนักเรียนเต็มตามที่กำหนดแล้ว ให้ตัดรายชื่อที่เหลือออก เพื่อนำไปพิจารณาในลำดับการเลือกถัดไป
  • 4) ต้องพิจารณาจาก “ลำดับการเลือก” ของนักเรียนแต่ละคน จาก 1 จนถึง 3
  • 5) นักเรียนจะได้โปรแกรมที่เลือกในอันดับแรกสุดเพียงลำดับเดียว

ลำดับการเขียนโค้ดอย่างไร

  • 1) ลิสต์รายการ โปรแกรมการเรียนตามลำดับการเลือกแต่ละรายการ
  • 2) Loop รายการโปรแกรมทีละโปรแกรม ตามลำดับการเลือก เพื่อนำไปเลือกรายนักเรียนที่เลือกโปรแกรมนั้น ๆ พร้อม คะแนนสอน ออกมา
  • 3) พิจารณาเลือก เฉพาะผู้ที่คะแนนถึงตามเกณฑ์ ลำดับก่อนหลังตาม ลำดับการเลือก และคะแนนที่ได้
  • 4) หากได้จำนวนครบตามจำนวนของแต่ละโปรแกรมแล้ว รายชื่อผู้สมัครที่เหลือจะถูกเอาไปพิจารณาในกลุ่มรายชื่อของอันดับต่อไป (ตามการเลือกของตนเอง)

ได้ Code แบบนี้

Sub ProgramSelection()

Dim i As Long, i_col As Long, j_row As Long, MySourceDataRows As Long
Dim MySelProgRng As Range, MyTempRow As Long, MyAdmittedTargetRow As Long
Dim MyMinimumScore As Long, MyMaxNumPerProgram As Long

MySourceDataRows = Sheet1.Range(“A” & Rows.Count).End(xlUp).Row
Range(“F2:F” & MySourceDataRows).ClearContents
Range(“L3:V” & MySourceDataRows).ClearContents
Range(“H15:J” & MySourceDataRows).ClearContents

‘1) list program by priority
For i_col = 2 To 4
For j_row = 2 To MySourceDataRows
If WorksheetFunction.CountIfs(Range(Cells(15, i_col + 6).Address, Cells(MySourceDataRows, i_col + 6).Address), Cells(j_row, i_col).Value) = 0 Then
Cells(MySourceDataRows, i_col + 6).End(xlUp).Offset(1, 0).Value = Cells(j_row, i_col).Value
End If
Next j_row
Next i_col


‘2) List ID by Priority and Program
For i_col = 8 To 10
For j_row = 15 To Cells(MySourceDataRows, i_col).End(xlUp).Row
MyMinimumScore = WorksheetFunction.VLookup(Cells(j_row, i_col).Value, Range(“H2:I11”), 2, 0)
For Each MySelProgRng In Range(Cells(2, i_col – 6).Address, Cells(MySourceDataRows, i_col – 6).Address)
MyTempRow = Range(“L” & Rows.Count).End(xlUp).Row + 1
If Range(“F” & MySelProgRng.Row).Value <> “Admitted” Then
If Range(“E” & MySelProgRng.Row).Value >= MyMinimumScore Then
If MySelProgRng.Value = Cells(j_row, i_col).Value Then
Range(“L” & MyTempRow).Value = MySelProgRng.Value
Range(“N” & MyTempRow).Value = Range(“A” & MySelProgRng.Row).Value
Range(“O” & MyTempRow).Value = Range(“E” & MySelProgRng.Row).Value
Range(“P” & MyTempRow).Value = Cells(14, i_col).Value
End If
End If
End If
Next MySelProgRng


‘3) List to selected program
‘sort by Score then by ID
Range(“L2:P” & MySourceDataRows).Sort key1:=Range(“O2”), order1:=xlDescending, key2:=Range(“N2”), order2:=xlAscending, Header:=xlYes
For MyTempRow = 3 To Range(“L” & Rows.Count).End(xlUp).Row
MyAdmittedTargetRow = Range(“R” & Rows.Count).End(xlUp).Row + 1
MyMaxNumPerProgram = WorksheetFunction.VLookup(Range(“L” & MyTempRow).Value, Range(“H2:J11”), 3, 0)
If WorksheetFunction.CountIfs(Range(“R:R”), Range(“L” & MyTempRow)) < MyMaxNumPerProgram Then
Range(“L” & MyTempRow, “P” & MyTempRow).Copy
Range(“R” & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range(“F” & WorksheetFunction.Match(Range(“N” & MyTempRow), Range(“A:A”), 0)).Value = “Admitted”
End If
Next MyTempRow
Range(“L3:P” & MySourceDataRows).ClearContents
Next j_row
Next i_col


‘ tidy up the final data
Range(“R2:V” & Range(“R” & Rows.Count).End(xlUp).Row).Sort key1:=Range(“R2”), order1:=xlAscending, key2:=Range(“U2”), order2:=xlDescending, Header:=xlYes
For i = 3 To Range(“R” & Rows.Count).End(xlUp).Row
Range(“S” & i).Value = WorksheetFunction.CountIfs(Range(“R2:R” & i), Range(“R” & i).Value)
Next i
MsgBox “F I N I S H ! ! !”
End Sub

————————————//———————————

👉 #สำหรับผู้ที่สนใจเรียนVBA

  • ทั้งสำหรับผู้ที่จริงจัง อยากเรียน VBA เพื่อเอาไปใช้งาน
  • หรือ คุณเป็นคนที่อยากหนีตายเพราะเบื่องาน Excel แบบถึก ๆ หรือ เป็นคนที่มุ่งมั่น อยากพัฒนา ยกระดับความสามารถ ขีดมาตรฐานใหม่ให้กับงานของตัวเอง
    #มาเจอกันครับ

รีบสมัครมาได้เลย!!!

👉 ทักมาที่ m.me/excelbypichart หรือ โทร. 099-084-2562
🔸 ปูพื้นฐานการเขียนโค้ด VBA ตั้งแต่เริ่ม ไม่ต้องมีพื้นฐาน Coding มาก็เรียนรู้เรื่อง และจะเขียนโค้ดเองได้ ไม่ใช่การบันทึก macro แล้วปรับ ๆ แก้ ๆ แต่เรียนเขียนโค้ด VBA จริง ๆ
🔸 เรียนจบมี…

  • มี Certificate
  • รับเข้ากลุ่มปิด Facebook เพื่อพูดคุยสอบถามเรียนรู้เพิ่มเติม
  • สามารถชมคลิปการเรียนย้อนหลังได้ตลอดเวลา

👉 ติดต่อสอบถามเนื้อหาเพิ่มเติม หรือสมัครได้ที่ลิงค์นี้ m.me/excelbypichart หรือ โทร. 099-084-2562 / 082-663-9949

————//————

อ.ชาติ

Learn Excel With Pichart

Smart Excel For Better LIFE

ใส่ความเห็น

อีเมลของคุณจะไม่แสดงให้คนอื่นเห็น ช่องข้อมูลจำเป็นถูกทำเครื่องหมาย *