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
