Form excel Input Data siswa ke tiap rombel kelas otomatis

RuangExcel : Salam sejahtera para pecinta dan pengguna microsoft excel, semoga dalam keadaan sehat dan sukses selalu. Pada kesempatan kali ini saya akan berbagi file microsoft excel berupa menu sebaran data ke rombel atau kelompok data tertentu. File microsoft excel yang saya berinama aplikasi sederhana "Menu Input Data Ke Rombel" bisa memudahkan para operator atau guru dalam input data peserta didik yang akan disebar ke tiap rombel kelas. Pada aplikasi sederhana ini terdapat 3 menu, yakni menu Form dan Database.

1. Menu Form 

Pada Menu Form ini terdapat kolom isian data jumlah rombel dan banyak siswa yang akan dibuatkan berupa format pada sheet database ketika kita telah kita klik tombol "buat database" serta isian data peserta didik yang akan diinput ke lembar kerja excel (sheet database) setelah kita melakukan pengisian data peserta didik dan melakukan klil tombol "Input Data".

2. Menu Database

Lembar kerja excel (sheet database) adalah sheet database yang akan menampung data inputan peserta didik dari lembar kerja excel (sheet form). Pada lembar kerja excel (sheet database) yang berisi format data peserta didik per rombel. Jika kita pada sheet form melakukan klik "buat database" maka format yang telah dibuat sebelumnya akan terhapus dengan format terbaru.

Jika anda ingin mengembangkan aplikasi ini silahkan unduh di sini dan kode scrip vba silahkan copas di bawah ini :

Sub BUAT_KOLOM()

    Set WRisi = Worksheets("FORM")

    Set WRdata = Worksheets("DATABASE")

    BARIS = 1

    For I = 1 To 200000

        If WRdata.Range("B" & I).Value <> "" Then

            For IA = 1 To 25

                WRdata.Cells(I, IA).Value = ""

                WRdata.Cells(I, IA).Font.Bold = True

                WRdata.Cells(I, IA).HorizontalAlignment = xlLeft

                WRdata.Cells(I, IA).Columns.ColumnWidth = 9

                WRdata.Cells(I, IA).Interior.ColorIndex = xlColorIndexNone

            Next IA

        End If

    Next I

    KL = 1

    NM = 0

    RB = 0

    BARIS = 1

    KOLOM = 1

    For RB = 1 To WRisi.Range("D3").Value

        WRdata.Cells(BARIS, 1).Value = "ROMBEL :  " & RB

        WRdata.Cells(BARIS, 1).Font.Bold = True

        WRdata.Cells(BARIS, 1).HorizontalAlignment = xlCenter

        WRdata.Cells(BARIS, 1).Columns.ColumnWidth = 15

        WRdata.Cells(BARIS, 1).Interior.ColorIndex = 6

        For I = 10 To 40

            If WRisi.Range("B" & I).Value <> "" Then

                KL = KL + 1

                WRdata.Cells(BARIS, KL).Value = WRisi.Range("B" & I).Value

                WRdata.Cells(BARIS, KL).Font.Bold = True

                WRdata.Cells(BARIS, KL).HorizontalAlignment = xlCenter

                WRdata.Cells(BARIS, KL).Columns.ColumnWidth = WRisi.Range("A" & I).Value

                WRdata.Cells(BARIS, KL).Interior.ColorIndex = 10

            End If

        Next I

        If WRisi.Range("D4").Value = "" Then Exit Sub

        For NM = 1 To WRisi.Range("D4").Value

           KOLOM = KOLOM + 1

           WRdata.Cells(KOLOM, 2).Value = NM

        Next NM

        KL = 1

        NM = NM + 1

        BARIS = BARIS + WRisi.Range("D4").Value + 1

        KOLOM = KOLOM + 1

    Next RB

End Sub

=============================================================

Private Sub CommandButton2_Click()

    Set WRisi = Worksheets("FORM")

    Set WRdata = Worksheets("DATABASE")

    KL = WRisi.Range("D7").Value 'rombel

    NM = WRisi.Range("D4").Value 'jmlsiswa

    If WRisi.Range("D3").Value < KL Then

        MsgBox "Rombel max " & WRisi.Range("D3").Value, vbInformation, "Peringatan"

        Exit Sub

    End If

       RB = 2

    If WRisi.Range("D11").Value <> "" Then

        For I = 1 To 200000

            If WRdata.Cells(I, 1).Value = "ROMBEL :  " & KL Then

                For IA = I To (I + NM)

                    If WRdata.Cells(IA, 3).Value = "" Then

                        For xs = 11 To 40

                            RB = RB + 1

                            WRdata.Cells(IA, RB).Value = WRisi.Range("D" & xs).Value

                        Next xs

                        Exit Sub

                    End If

                Next IA

             End If

        Next I

    End If

End Sub

=============================================================

Private Sub CommandButton3_Click()

    pesane = MsgBox("Semua database yang tersimpan akan terhapus, Anda yakin akan membuat kolom baru ", vbYesNo, "cetak")

    If pesane = vbYes Then

        Call BUAT_KOLOM

    End If

End Sub