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






















Komentar

  1. Hi Bli,

    http://www.fdrlibrary.marist.edu/exit.html?link=http://economic4today.blogspot.com

    BalasHapus
  2. One more:

    http://www.roc.noaa.gov/scripts/exit/osfexit.pl?url=http://economic4today.blogspot.com

    BalasHapus
  3. mau tanya bos
    kalau 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)

    BalasHapus
  4. informasinya sangat bermanfaat banget ya?
    Ehm, sambil baca beritanya, Saya ikut promosi ya.
    Agen Bola, Bandar Bola Online, Situs Taruhan Bola, 7meter

    BalasHapus

Posting Komentar