excel macro & data validation
Halo … Bro,.. Sis,…
Sekedar berbagi tips
excel menggunakan macro dan data validation sebelumnya pembaca pasti
udah pada tau tentang macro di excel , yaitu visual basic
application yang memungkinkan kita dapat menggunakan code Visual
basic pada excel dengan tujuan mempermudah pekerjaan. Untuk info
lebih jelasnya mengenai data validation silahkan Googling aja ya.
Beberapa bulan lalu ane dapet tugas
dari atasan untuk membuat laporan packing list (daftar pengiriman)
yang formatnya kayak gini .
Idenya, bos ane maunya rekan-rekan
di cabang input datanya hanya pada baris SEND DATE , ATTN, CC,
DRIVER, PHONE NO, VEHICLE NO, SOS, TUID, STAND TYPE, REFF DA dan
CHARGE CODE dengan cara manual atau di ketik sedangkan baris ORIGIN,
DESTINATION, PN dan Store input nya menggunakan data validation.
Kolom yang di warnai Ungu: MODEL, SN
– PREFIX, DESCRIPTION, WEIGHT serta TRANSPORT COST input nya
menggunakan macro .
Keterangan gambar yang di tandai
kotak biru input datanya manual , yang ditandai kotak merah input
datanya dengan data validation, label kolom yang di warnai Ungu data
di input dengan macro.
Langsung aja kita mulai, keterangan
singkat Office yang digunakan adalah Microsoft office 2010 ,
Operating system mengunakan Windows XP sp 3 berikut mengenai data validation:
-pada baris
“ORIGIN” data validationnya di letakkan di kolom M baris 104
sampai baris 124.
-pada baris
“DESTINATION” data validationnya di letakkan di kolom M baris 104
sampai baris 124
-Pada baris “Store”
data validationnya di letakkan di kolom L baris 104 sampai baris 124.
-Pada Kolom “PN”
data validationnya di letakkan di kolom CP baris 22 sampai baris 214.
Untuk Baris “ORIGIN” Klik kiri
pada kolom F baris 7 kemudian arahkan kursor ke menu “Data”
klik kiri, kemudian arahkan kursor ke toolbar “Data Validation”
pilih data validation.
Setelah Data
validation di klik kiri maka akan muncul menu seperti berikut pada
menu Allow: pilih “list”
Kemudian Source nya
ketik “ =$M$104:$M$124 ” ini adalah tempat data validation di
letakkan kolom M baris 104 sampai baris 124.
Untuk Baris “Store”
Klik kiri pada kolom K baris 3 langkah selanjutnya sama dengan
sebelumnya pada menu Data validation untuk “Allow” pilih list dan
Sourcenya ketik “ =$L$104:$L$124 ” ini adalah tempat data
validation di letakkan kolom L baris 104 sampai baris 124.
Pada baris
“DESTINATION” klik kiri pada kolom F baris 11 langkah selanjutnya
sama dengan sebelumnya untuk Allow: pilih “list” kemudian Source
nya ketik “ =$M$104:$M$124 ”.
Pada kolom “PN”
silahkan klik kiri kolom D baris 19 dan seret sampai pada baris 28
langkah selanjutnya sama dengan sebelumnya untuk Allow: pilih “list”
kemudian Source nya ketik “ =$CP$22:$CP$214 ”.
Data validation
sudah kita selesaikan berikut hasilnya jika di coba, pada contoh
dibawah klik kolom F baris 7 yang merupakan data validation “ORIGIN”
maka muncul data data yang kita letakkan di kolom M baris 104 sampai
baris 124, tinggal kita pilih data yang ingin di munculkan. Sebagai
catatan pada data validation tidak diperkenankan menginput data
dengan cara di ketik. Pada baris DESTINATION (F11), PN (D19-D28) dan
Store (K3) silahkan dicoba.
Pada Project ini
macro di letakan pada tiga tempat pertama di letakan di Sheet1 yang
kedua di Thisworkbook dan yang terakhir di letakan di Module1. Macro
yang di letakan di Sheet1 digunakan untuk mendeteksi setiap perubahan
nilai yang terjadi akan menjalankan macro secara otomatis sedangkan
macro yang di letakan di Thisworkbook digunakan untuk menjalankan
macro pada saat file Packing list di open atau di close, seperti
menghidupkan timer dan mematikannya. Yang terakhir macro di letakan
di Module1, timer yang di hidupkan pada saat file di open di setting
setiap satu detik akan menjalankan macro pada Module1.
ORIGIN dengan Store
saling terhubung karena Store adalah kode angka dari ORIGIN , maka
timbul ide untuk me link kan antara keduanya dalam artian jika kita
rubah data ORIGIN maka data Store akan berubah juga secara otomatis
begitu juga jika kita rubah data Store maka data ORIGIN akan berubah
juga secara otomatis. Untuk merealisasikannya kita menggunakan macro.
Potongan code pada
Module1:
If Cells(7, 6).Value
<> Cells(5, 10).Value Then
Cells(5,
10).Value = Cells(7, 6).Value
i = 104
Do Until
Cells(i, 12).Value = ""
If Cells(i,
13).Value = Cells(7, 6).Value Then
Cells(3, 11).Value = Cells(i, 12).Value
End If
i = i + 1
Loop
End If
Potongan code pada
Sheet1:
If
Target.Cells.Value <> "" And Target.Cells = Cells(3,
11) Then
cari:
i = 104
Do Until
Cells(i, 12).Value = ""
If Cells(i,
12).Value = Cells(3, 11).Value Then
Cells(5, 10).Value = Cells(i, 13).Value
Cells(7, 6).Value = Cells(i, 13).Value
……...
……….
………
End if
i = i+1
loop
End if
Keterangan singkat
mengenai kode pada Module1 di atas, jika nilai cells baris 5 kolom 10
tidak sama dengan nilai baris 7 kolom 6 maka ubah nilai baris 5 kolom
10 tersebut di sama kan dengan nilai baris 7 kolom 6 kemudian cari
kode ORIGIN tersebut di kolom M baris 104 sampai 124 jika kodenya
sudah ditemukan maka ubah nilai baris 3 kolom 11 dengan kode
tersebut. Macro pada Sheet1 juga sama cara kerjanya jika nilai cells
baris 5 kolom 10 tidak sama dengan nilai baris 7 kolom 6 maka ubah
nilai baris 7 kolom 6 tersebut di sama kan dengan nilai baris 5
kolom 10 kemudian cari kode ORIGIN tersebut di kolom M baris 104
sampai 124 jika kodenya sudah ditemukan maka ubah nilai baris 3 kolom
11 dengan kode tersebut. Perbedaanya pada Sheet1 macronya
menggunakan instruksi “Target.Cells.Value” untuk mendeteksi
perubahan nilai di cell target jadi setiap perubahan nilai yang
terjadi macro akan secara otomatis dijalankan. Sedangkan macro di
Module1 dijalankan setiap satu detik oleh timer. Dengan
mengkombinasikan kedua teknik ini maka ORIGIN dengan Store saling
terhubung nilainya. Setiap kali nilai ORIGIN di rubah maka nilai
Store pun akan berubah otomatis begitu juga sebaliknya.
Data yang di input
di kolom MODEL, SN – PREFIX , DESCRIPTION ,TRANSPORT COST di
lakukan oleh macro data ini tergantung pada data yang di input pada
kolom, ORIGIN, DESTINATION dan PN. Jadi setelah data ORIGIN ,
DESTINATION dan PN di input maka macro akan mencari data MODEL, SN –
PREFIX , DESCRIPTION ,TRANSPORT COST dan WHEIGHT yang sesuai di kolom
CP baris 22 sampai baris 214.
Input data pada
kolom PN selain melalui data validation bisa juga dengan cara copy
paste dan agar macro dapat mendeteksi copy paste ini kita gunakan
timer pada macro, interval waktu yang kita setting di timer adalah
satu detik. Jadi setiap satu detik timer akan menjalankan macro pada
Module1 yang akan mengecek perubahan pada kolom PN Timer di aktifkan
secara otomatis pada saat file Packing list di buka dan timer di
matikan pada saat file Packing list di tutup dan macro yang
melakukannya di letakan di di Thisworkbook dan berikut adalah
macronya.
Option Explicit
Dim timer_enabled As
Boolean
Private Sub
Workbook_Open()
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"),
Procedure:="Otakkidal"
End Sub
Private Sub
Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"),
Procedure:="Otakkidal", Schedule:=False
End Sub
Untuk input data
melalui data validation macro mendeteksi setiap perubahan nilai pada
kolom PN menggunakan fungsi Private Sub Worksheet_Change(ByVal Target
As Range) pada macro di Sheet1. Jadi setiap perubahan nilai pada
kolom PN macro akan di jalankan secara otomatis dan proses pencarian
data akan di jalankan.
Jadi pendeteksian
perubahan nilai pada kolom PN menggunakan dua teknik yang di jalankan
bersamaan berikut code
silahkan di pelajari,
Copy paste code
berikut di Sheet1 seperti gambar klik kiri Developer kemudian klik
kiri visual basic kemudian klik kiri Sheet1 selanjutnya paste code di
bawah
'=================================
'WE ARE just
Ordinary People
'=================================
Option Explicit
Dim OldCellValue As
String
Dim i As Double
Dim ii As Double
Dim aa As Double
Dim jh As Double
Dim hy As Double
Dim jj As Double
Dim cel As Range,
match1 As Range, match2 As Range, rg As Range, targ As Range
Private Sub
Worksheet_Change(ByVal Target As Range)
'ini adalah sekurity
untuk mencegah multi cells
If
Target.Cells.Count > 1 Then Exit Sub
If
Target.Cells.Text = "" Then Exit Sub
If Cells(3,
11).Value = "" Then
GoTo yuhu
End If
'disini autocomplete
nya
'mencari
deskripsi store
If
Target.Cells.Value <> "" And Target.Cells = Cells(3,
11) Then
cari:
i = 104
Do Until
Cells(i, 12).Value = ""
If Cells(i,
12).Value = Cells(3, 11).Value Then
Cells(5, 10).Value = Cells(i, 13).Value
Cells(7, 6).Value = Cells(i, 13).Value
'mencari harganya
If
Cells(19, 4).Value <> "" Then
For hy = 19 To 28
jj = 22
Do Until Cells(jj, 94).Value = ""
If (Cells(jj, 94).Value = Cells(hy, 4).Value) And
(Cells(jj, 97).Value = Cells(hy, 6).Value) And (Cells(jj, 98).Value =
Cells(hy, 7).Value) Then
jh = 103
Do Until Cells(21, jh).Value = ""
If Cells(21, jh).Value = Cells(7, 6).Value Then
Cells(hy, 15).Value = Cells(jj, jh).Value
'GoTo yuhu
End If
jh = jh + 1
Loop
End If
jj = jj + 1
Loop
Next hy
End
If
'batassssssssssssss kesabaran
GoTo
yuhu
End If
i = i + 1
Loop
End If
'mencari price nya
If
Target.Cells.Value <> "" And (Target.Cells =
Cells(19, 4) Or Target.Cells = Cells(20, 4) Or Target.Cells =
Cells(21, 4) Or Target.Cells = Cells(22, 4) Or Target.Cells =
Cells(23, 4) Or Target.Cells = Cells(24, 4) Or Target.Cells =
Cells(25, 4) Or Target.Cells = Cells(26, 4) Or Target.Cells =
Cells(27, 4) Or Target.Cells = Cells(28, 4)) Then
ii = 22
aa = 0
Do Until
Cells(ii, 94).Value = ""
If
Cells(ii, 94).Value = Target.Cells.Value Then
OldCellValue = Cells(ii, 98).Value
'cek
Modelnya apa??
If
Target.Cells = Cells(19, 4) Then
i =
19
End If
If
Target.Cells = Cells(20, 4) Then
i = 20
End If
If
Target.Cells = Cells(21, 4) Then
i = 21
End If
If
Target.Cells = Cells(22, 4) Then
i =
22
End If
If
Target.Cells = Cells(23, 4) Then
i =
23
End If
If
Target.Cells = Cells(24, 4) Then
i =
24
End If
If
Target.Cells = Cells(25, 4) Then
i =
25
End If
If
Target.Cells = Cells(26, 4) Then
i =
26
End If
If
Target.Cells = Cells(27, 4) Then
i =
27
End If
If
Target.Cells = Cells(28, 4) Then
i =
28
End If
'ini tempat
untuk mengecek prefix
'Application.Wait Now + TimeValue("00:00:02")
'If
MsgBox(" INPUT SN-PREFIX UNIT APAKAH " & Cells(ii,
98).Value, vbYesNo) = vbYes Then
'
Cells(i, 7).Value = Cells(ii, 98).Value
'Else:
'MsgBox "Delete all comments?"
'End
If
If
(MsgBox(Cells(i, 3).Value & ". " & " PN "
& Cells(ii, 94).Value & " MODEL UNIT APAKAH " &
Cells(ii, 97).Value & " DAN SN-PREFIXNYA APAKAH " &
Cells(ii, 98).Value & " ?", vbYesNo) = vbYes And
Cells(i, 4).Value <> "") Then
aa = 1
Cells(i, 6).Value = Cells(ii, 97).Value
Cells(i, 7).Value = Cells(ii, 98).Value
Cells(i, 8).Value = Cells(ii, 100).Value
Cells(i, 11).Value = Cells(ii, 102).Value
Else:
jh = ii
Do Until Cells(jh, 94).Value = ""
If (Cells(jh, 94).Value = Target.Cells.Value And Cells(jh,
98).Value <> OldCellValue) Then
If (MsgBox(Cells(i, 3).Value & ". " & "
PN " & Cells(ii, 94).Value & " MODEL UNIT APAKAH "
& Cells(jh, 97).Value & " DAN SN-PREFIXNYA APAKAH "
& Cells(jh, 98).Value & " ?", vbYesNo) = vbYes And
Cells(i, 4).Value <> "") Then
aa = 1
Cells(i, 6).Value = Cells(jh, 97).Value
Cells(i, 7).Value = Cells(jh, 98).Value
Cells(i, 8).Value = Cells(jh, 100).Value
Cells(i, 11).Value = Cells(jh, 102).Value
GoTo lagi
End If
End If
jh = jh + 1
Loop
If Cells(jh, 94).Value = "" And Cells(i, 4).Value <>
"" Then
MsgBox Cells(i, 3).Value & ". " & " PN
" & Cells(ii, 94).Value & " MODEL UNIT AKAN KITA
ISI " & Cells(ii, 97).Value & " SN-PREFIX AKAN KITA
ISI " & Cells(ii, 98).Value
aa = 1
Cells(i, 6).Value = Cells(ii, 97).Value
Cells(i, 7).Value = Cells(ii, 98).Value
Cells(i, 8).Value = Cells(ii, 100).Value
Cells(i, 11).Value = Cells(ii, 102).Value
End If
lagi:
End
If
'mengecek
nilai cost nya
jh =
103
Do
Until Cells(21, jh).Value = ""
If
Cells(21, jh).Value = Cells(7, 6).Value Then
Cells(i, 15).Value = Cells(ii, jh).Value
GoTo yuhu
End
If
jh =
jh + 1
Loop
GoTo
yuhu
End If
ii = ii + 1
Loop
' If aa = 0
Then
' MsgBox "
PASTIKAN PENULISAN PART NO SUDAH BENAR "
'
GoTo yuhu
'End If
End If
'set target
yuhu:
End Sub
Copy paste code
berikut pada Thisworkbook
'##############################################
'##############################################
Option Explicit
Dim timer_enabled As
Boolean
Private Sub
Workbook_Open()
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"),
Procedure:="Otakkidal"
End Sub
Private Sub
Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"),
Procedure:="Otakkidal", Schedule:=False
End Sub
Copy paste code
berikut pada Module1
'00000000000000000000000000000000000000000
'000000000000000000000000000000000000000000
Sub Otakkidal()
Dim i As Double
Dim hy As Double
Dim a As Double
Dim jj As Double
Dim jh As Double
Dim ii As Double
Dim aa As Double
Dim OldCellValue As
String
If Cells(7, 6).Value
<> Cells(5, 10).Value Then
Cells(5,
10).Value = Cells(7, 6).Value
i = 104
Do Until
Cells(i, 12).Value = ""
If Cells(i,
13).Value = Cells(7, 6).Value Then
Cells(3, 11).Value = Cells(i, 12).Value
End If
i = i + 1
Loop
End If
For hy = 19 To 28
'mencari harganya
If Cells(hy,
4).Value <> "" Then
' MsgBox "
TImer kedua "
a = 0
jj = 22
Do Until Cells(jj, 94).Value = ""
If (Cells(jj, 94).Value = Cells(hy, 4).Value) And
(Cells(jj, 97).Value = Cells(hy, 6).Value) And (Cells(jj, 98).Value =
Cells(hy, 7).Value) Then
a = 1
jh = 103
Do Until Cells(21, jh).Value = ""
If Cells(21, jh).Value = Cells(7, 6).Value Then
Cells(hy, 15).Value = Cells(jj, jh).Value
GoTo yuhua
End If
jh = jh + 1
Loop
End If
jj = jj + 1
Loop
If a = 0 Then
'mencari price nya
ii = 22
aa = 0
Do Until Cells(ii, 94).Value = ""
If Cells(ii, 94).Value = Cells(hy, 4).Value Then
' If OldCellValue = "" Then
OldCellValue = Cells(ii, 98).Value
' End If
'cek
Modelnya apa??
'ini tempat
untuk mengecek prefix
If (MsgBox(Cells(hy, 3).Value & ". " & "
PN " & Cells(ii, 94).Value & " MODEL UNIT APAKAH "
& Cells(ii, 97).Value & " DAN SN-PREFIXNYA APAKAH "
& Cells(ii, 98).Value & " ?", vbYesNo) = vbYes And
Cells(hy, 4).Value <> "") Then
aa = 1
Cells(hy, 6).Value = Cells(ii, 97).Value
Cells(hy, 7).Value = Cells(ii, 98).Value
Cells(hy, 8).Value = Cells(ii, 100).Value
Cells(hy, 11).Value = Cells(ii, 102).Value
Else:
jh = ii
Do Until Cells(jh, 94).Value = ""
If (Cells(jh, 94).Value = Cells(hy, 4).Value And
Cells(jh, 98).Value <> OldCellValue) Then
If (MsgBox(Cells(hy, 3).Value & ". "
& " PN " & Cells(ii, 94).Value & " MODEL
UNIT APAKAH " & Cells(jh, 97).Value & " DAN
SN-PREFIXNYA APAKAH " & Cells(jh, 98).Value & "
?", vbYesNo) = vbYes And Cells(hy, 4).Value <> "")
Then
aa = 1
Cells(hy, 6).Value = Cells(jh, 97).Value
Cells(hy, 7).Value = Cells(jh, 98).Value
Cells(hy, 8).Value = Cells(jh, 100).Value
Cells(hy, 11).Value = Cells(jh, 102).Value
GoTo lagix
End If
End If
jh = jh + 1
Loop
If Cells(jh, 94).Value = "" And
Cells(hy, 4).Value <> "" Then
MsgBox Cells(hy, 3).Value & ". "
& " PN " & Cells(ii, 94).Value & " MODEL
UNIT AKAN KITA ISI " & Cells(ii, 97).Value & "
SN-PREFIX AKAN KITA ISI " & Cells(ii, 98).Value
aa = 1
Cells(hy, 6).Value = Cells(ii, 97).Value
Cells(hy, 7).Value = Cells(ii, 98).Value
Cells(hy, 8).Value = Cells(ii, 100).Value
Cells(hy, 11).Value = Cells(ii, 102).Value
End If
lagix:
End If
'mengecek nilai cost nya
jh = 103
Do Until Cells(21, jh).Value = ""
If Cells(21, jh).Value = Cells(7, 6).Value Then
Cells(hy, 15).Value = Cells(ii, jh).Value
GoTo yuhua
End If
jh = jh + 1
Loop
GoTo yuhua
End If
ii = ii + 1
Loop
'If aa = 0 Then
'MsgBox " PASTIKAN PENULISAN PART NO SUDAH BENAR "
' GoTo yuhua
' End If
End If
End If
yuhua:
Next hy
'reset timer
menjadi 4 detik
timer_enabled =
True
Application.OnTime EarliestTime:=Now + TimeValue("00:00:01"),
Procedure:="Otakkidal"
'Application.EnableEvents = True
'timer_enabled =
True
End Sub
Hi Bli,
BalasHapushttp://www.fdrlibrary.marist.edu/exit.html?link=http://economic4today.blogspot.com
One more:
BalasHapushttp://www.roc.noaa.gov/scripts/exit/osfexit.pl?url=http://economic4today.blogspot.com
mau tanya bos
BalasHapuskalau mau meng input data lebih dari satu dan di simpan ke databasenya gimana
sheet input data range b7:fx (sampai akhir inputan) (sheet1) dan sheet database (sheet2)
informasinya sangat bermanfaat banget ya?
BalasHapusEhm, sambil baca beritanya, Saya ikut promosi ya.
Agen Bola, Bandar Bola Online, Situs Taruhan Bola, 7meter
nice post
BalasHapusblogwalking gan
Jadwal Tematik SD
Prasangka Baik
5 Formula dasar Excel
menggunakan data validation list
3 Perpustakaan Terbaik di Dunia
Keberagaman di Indonesia