Aplikasi Teknik Perulangan Do ... Loop Until .... dalam VBA Excel
Seperti kita ketahui Teknik Perulangan dalam VBA Excel ada dua yaitu :
1. For ...... Next
2. Do ..... Loop Until.
Pembahasan kita kali ini adalah aplikasinya di dalam Excel untuk membuat sel bergerak membentuk sebuah kotak dan sekaligus mewarnainya.
Perhatikan program dan gambar di bawah ini :
Kita analisa program di atas, satu per satu dimulai dengan gambar di bawah ini :
01. Kita mulai dengan menempatkan kursor (Sel Aktif / Activecell ) pada posisi sel J19.
Posisi J19, berarti memiliki Kolom = 10 dan Baris = 19
02. Agar kursor nanti berhenti pada kolom 10 dan Baris 19
maka kolom 10 dan Baris 19 direkam terlebih dahulu dengan deklarasi sebagai berikut
Sub KiriAtasKananDo_UTurnArrow1_Click()
Kolom = ActiveCell.Column
Baris = ActiveCell.Row
End Sub03. Gunakan Do .... Loop Until, agar berhenti sesuai dengan kolom dan baris di atas
Do
Loop Until ActiveCell.Column = Kolom
Do
Loop Until ActiveCell.Row = Baris04. Pada Do ..... Loop Until yang pertama, gunakan program ke kiri - atas - kanan
05. Geser ke kiri apabila Kolom > 1 dan Baris > 1, lihat program di bawah ini
Do
If ActiveCell.Column > 1 And ActiveCell.Row > 1 Then
ActiveCell.Interior.ColorIndex = ActiveCell.Column
ActiveCell.Offset(0, -1).Select
Else
End If
Loop Until ActiveCell.Column = Kolom06. Apabila kolom > 1 dan baris > 1, maka beri warna sesuai dengan colorindex kolom
ActiveCell.Interior.ColorIndex = ActiveCell.Columndan geser ke kiri seperti skrip di bawah ini :
ActiveCell.Offset(0, -1).Selectprogram setelah Else tidak dijalankan sampai ketemu
End If07. Program mengulangi dari Do, ketika ketemu
Loop Until ActiveCell.Column = KolomHal ini disebabkan ketika bergeser ke kiri, otomatis kolom sel-aktif < 10
08. Langkah 5 - 7 terus diulangi sampai sel-aktif pada posisi A19.
Perhatikan gambar di bawah ini.
09. Pada posisi A19, kolom sel-aktif = 1 sehingga syarat langkah 5 tidak dapat dipenuhi
10. Program yang akan dijalankan adalah
Do
If ActiveCell.Column > 1 And ActiveCell.Row > 1 Then
Else
If ActiveCell.Row > 1 Then
ActiveCell.Interior.ColorIndex = ActiveCell.Row
ActiveCell.Offset(-1, 0).Select
Else
End If
End If
Loop Until ActiveCell.Column = Kolom11. Ketika syarat pada langkah 5 tidak terpenuhi, maka ada Pencabangan berikutnya
12. Jika Baris > 1, beri warna sesuai dengan ColorIndex Baris.
Posisi A19 memenuhi syarat, sehingga sel-aktif diberi warna dan geser ke atas
ActiveCell.Interior.ColorIndex = ActiveCell.Rowdan sel-aktif bergeser ke atas satu baris
ActiveCell.Offset(-1, 0).Select13. Langkah 10 sampai 12 terus diulang sampai pada posisi A1
14. Pada posisi A1, syarat pada langkah 5 dan langkah 12 tidak terpenuhi.
Sehingga program yang dijalankan adalah :
Do
If ActiveCell.Column > 1 And ActiveCell.Row > 1 Then
Else
If ActiveCell.Row > 1 Then
Else
ActiveCell.Interior.ColorIndex = ActiveCell.Column
ActiveCell.Offset(0, 1).Select
End If
End If
Loop Until ActiveCell.Column = Kolom15. Perintah yang dijalankan adalah memberi warna sesuai ColorIndex Kolom
ActiveCell.Interior.ColorIndex = ActiveCell.Columndan Geser Kanan sesuai dengan :
ActiveCell.Offset(0, 1).Select16. Langkah 14 dan 15 terus diulang sampai berhenti pada kolom 10 pada perintah
17. Perintah berikutnya adalah memberi warna sesuai dengan ColorIndex Kolom.Loop Until ActiveCell.Column = Kolom
Perintahnya adalah :
ActiveCell.Interior.ColorIndex = ActiveCell.Column18. Berikutnya adalah Pengulangan untuk geser ke bawah dan memberi warna
19. Skrip programnya adalah :
Do
ActiveCell.Offset(1, 0).Select
ActiveCell.Interior.ColorIndex = ActiveCell.Row
Loop Until ActiveCell.Row = Baris
End Sub
Kustiyadi, ST
Belum ada Komentar untuk "Aplikasi Teknik Perulangan Do ... Loop Until .... dalam VBA Excel"
Posting Komentar