DataNumen Mark Entry System – Ingyenes jegybejegyzési rendszer tanárok számára

Excel megoldások October 3, 2025

A tanároknak mindig rengeteg feladatot kell elvégezniük. Jegyzeteket kell készíteniük a holnapi órára, nyomon kell követniük a tanulók teljesítményét, jelentéseket kell készíteniük a felső vezetés számára és még sok mást. Tegyük könnyű feladattá számukra a jelölés beírását.

Töltse le most

Ha azt szeretné, hogy start hogy a lehető leghamarabb használja a szoftvert, akkor:

Töltse le a szoftvert most

Ellenkező esetben, ha barkácsolni szeretne, az alábbiakban olvashatja a tartalmat.

Készítsük el a GUI-t

A képeken látható módon készítse elő a szerszámot a szükséges lapokkal.

Lap neve	Leírás
belépés	Ez a GUI a jelölés beviteléhez.
adatbázis	Ez a lap adatbázisként működik, és a tanulók jegyeit tárolja
Lista	Ez a munkalap olyan adatokat tartalmaz, amelyeket legördülő menük létrehozásához használunk fel.
Diákok	Ez a lap a különböző tanulókat a megfelelő osztályokhoz térképezi fel.

A VBA projekt ablakában nevezze át a lapokat az itt látható módon.

Tegyük működőképessé

Másolja a makrót egy új modulba, és csatolja a makrókat a megfelelő gombokhoz.

Macro	Csatlakoztassa a gombhoz	Leírás
Class_dropdown	-	Ez a makró létrehozza az „Osztály” legördülő menüt
Section_dropdown	-	Ez a makró létrehozza a „Szakasz” legördülő menüt
Tárgy_legördülő menü	-	Ez a makró létrehozza a „Tárgy” legördülő menüt
Show_List	Lista megjelenítése	Ez a makró a kiválasztott osztály és szakasz tanulóit jeleníti meg
Add_To_Database	Küldés	Ez a makró feltöltése jelölje meg a bejegyzéseket az adatbázislapon.

Sub Class_dropdown()
    Dim lr As Long
    Dim r As Long
    lr = lst.Range("A" & Rows.Count).End(xlUp).Row
    Dim prodlist As String
    For r = 2 To lr
        If prodlist = "" Then
            prodlist = lst.Range("A" & r).Value
        Else
            prodlist = prodlist & "," & lst.Range("A" & r).Value
        End If
        Next r
        With entry.Range("C2:D2").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=prodlist
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
End Sub

Sub Section_dropdown()
    Dim lr As Long
    Dim r As Long
    lr = lst.Range("B" & Rows.Count).End(xlUp).Row
    Dim prodlist As String
    For r = 2 To lr
        If prodlist = "" Then
            prodlist = lst.Range("B" & r).Value
        Else
            prodlist = prodlist & "," & lst.Range("B" & r).Value
        End If
        Next r
        With entry.Range("G2:H2").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=prodlist
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
End Sub

Sub Subject_dropdown()
    Dim lr As Long
    Dim r As Long
    lr = lst.Range("C" & Rows.Count).End(xlUp).Row
    Dim prodlist As String
    For r = 2 To lr
        If prodlist = "" Then
            prodlist = lst.Range("C" & r).Value
        Else
            prodlist = prodlist & "," & lst.Range("C" & r).Value
        End If
        Next r
        With entry.Range("K2:O2").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=prodlist
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
End Sub

Sub Show_List()
    Dim r As Long
    Dim lr As Long
    Dim e As Long
    e = 5
    lr = std.Range("A" & Rows.Count).End(xlUp).Row
    For r = 2 To lr
        If std.Range("A" & r).Value = entry.Range("C2").Value And std.Range("B" & r).Value = entry.Range("G2").Value Then
            e = e + 1
            entry.Range("B" & e).Value = std.Range("C" & r).Value
            entry.Range("C" & e).Value = std.Range("D" & r).Value
        End If
        Next r
End Sub

Sub Add_To_Database()
    Dim r As Long
    Dim lr As Long
    Dim e As Long
    e = 5
    lr = entry.Range("B" & Rows.Count).End(xlUp).Row
    For r = 6 To lr
        Dim lrind As Long
        lrind = db.Range("B" & Rows.Count).End(xlUp).Row + 1
        db.Range("A" & lrind).Value = entry.Range("C2").Value
        db.Range("B" & lrind).Value = entry.Range("G2").Value
        db.Range("C" & lrind).Value = entry.Range("K2").Value
        db.Range("D" & lrind).Value = entry.Range("C" & r).Value
        db.Range("E" & lrind).Value = entry.Range("K" & r).Value
        Next r
End Sub

Csípje meg

Ez a szkript lehetővé teszi egy nagyon egyszerű jegybeviteli rendszer létrehozását. Azonban módosíthatja, és analitikai jelentéseket hozhat létre az „Adatbázis” lap adatainak felhasználásával. Célszerű biztonsági másolatot készíteni az adatbázislapról. Ez segít helyreállítani a sérült xlsx lapot.

Szerző Bevezetés:

Nick Vipond adat-helyreállítási szakértő DataNumen, Inc., amely világelső az adat-helyreállítási technológiák területén, beleértve korrupt szó és az Outlook helyreállítási szoftvertermékei. További információért látogasson el www.datanumen.com.