Salam master excel,
Akhir tahun 2012 saya pernah menanyakan masalah ini ke milis
dan sudah ditanggapai temen-temen milis sangat memuaskan, setelah saya mendapat
jawaban dari temen-temen milis saya mencoba untuk mengembangkan sesuai apa yang
saya butuhkan dengan menggunakan pemahaman saya sendiri.
Setelah saya membuat modul VBA dengan pemahaman bahasa saya sendiri,
saya mohon masukan para master excel poin-point mana yang bisa
diringkas/diefisienkan. Modul saya pindah ke
notepad, tadi saya mau kirimkan dengan excelnya ukurannya hampir 700kb jadi
saya hanya copykan modulnya saja. Gambarannya setiap sub prosedur saya bikin
satu tombol,
dan bagaimana jika satu modul yang terdiri dari beberapa sub dibuat 1 tombol.
Semoga bahsa saya tidak membingungkan temen
temen....
Terimaskih
Option Explicit
' ---------------------------- '
' Code by Jan Raisin '
' untuk millis Belajar Excel '
' 12 November 2012 '
' ---------------------------- '
' nama prosedur
Sub DistKeSheet()
' deklarasi header Tanggal, range Tanggal, & cell Tanggal
' tipe data adalah range karena yang akan diambil adalah object-nya
Dim hdTgl, rgTgl, cTgl As Range
' deklarasi varabel untuk menyimpan nomor baris data
' tipe data adalah long integer (Long) agar dapat memuat nilai yang sangat
besar
Dim rData, c As Long
' deklarasi variabel untuk menyimpan nama sheet
' tipe data adalah string karena akan digunakan menyimpan data berupa text
/ string
Dim NamaSheet As String
' deklarasi variabel untuk menyimpan saldo akhir
' tipe data adalah dobel untuk mengantisipasi nilai dalam bentuk desimal
Dim Saldo As Double
Dim rng As Range, lRec As Long '<<<<<<<<< Baru untuk bpp
Set rng = Sheet2.Range("c10").CurrentRegion '<<<<<<< baru
With rng
lRec = .Rows.Count - 1
If lRec > 0 Then
With .Resize(lRec, 1).Offset(9, 2)
.Formula = "=if(d10="""","""",row()-9)"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 5)
.Formula = "=if(d10="""","""",Index(Master!$B$4:$B$46, Match(D10,
Master!$C$4:$C$46, 0)))"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 20)
.Formula = "=IF(F10="""",0,INDEX(Master!$E$4:$M$46,
MATCH(F10,Master!$B$4:$B$46,0), MATCH(u$7,Master!$E$2:$M$2,0)))"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 21)
.Formula = "=IF(F10="""",0,INDEX(Master!$E$4:$M$46,
MATCH(F10,Master!$B$4:$B$46,0), MATCH(v$7,Master!$E$2:$M$2,0)))"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 22)
.Formula = "=IF(F10="""",0,INDEX(Master!$E$4:$M$46,
MATCH(F10,Master!$B$4:$B$46,0), MATCH(w$7,Master!$E$2:$M$2,0)))"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 23)
.Formula = "=IF(F10="""",0,INDEX(Master!$E$4:$M$46,
MATCH(F10,Master!$B$4:$B$46,0), MATCH(x$7,Master!$E$2:$M$2,0)))"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 24)
.Formula = "=IF(F10="""",0,INDEX(Master!$E$4:$M$46,
MATCH(F10,Master!$B$4:$B$46,0), MATCH(y$7,Master!$E$2:$M$2,0)))"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 25)
.Formula = "=IF(F10="""",0,INDEX(Master!$E$4:$M$46,
MATCH(F10,Master!$B$4:$B$46,0), MATCH(z$7,Master!$E$2:$M$2,0)))"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 26)
.Formula = "=IF(F10="""",0,INDEX(Master!$E$4:$M$46,
MATCH(F10,Master!$B$4:$B$46,0), MATCH(aa$7,Master!$E$2:$M$2,0)))"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 27)
.Formula = "=IF(F10="""",0,INDEX(Master!$E$4:$M$46,
MATCH(F10,Master!$B$4:$B$46,0), MATCH(ab$7,Master!$E$2:$M$2,0)))"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(9, 28)
.Formula = "=IF(F10="""",0,INDEX(Master!$E$4:$M$46,
MATCH(F10,Master!$B$4:$B$46,0), MATCH(ac$7,Master!$E$2:$M$2,0)))"
.Parent.Calculate
.Value = .Value
End With
End If
End With
'untuk membersihkan sheet
Sheets("bku").Select
Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
Range(Range("g8"), Range("g8")).ClearContents
Sheets("Tunai").Select
Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
Range(Range("g8"), Range("g8")).ClearContents
Sheets("bank").Select
Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
Range(Range("g8"), Range("g8")).ClearContents
Sheets("perjadin").Select
Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
Range(Range("g8"), Range("g8")).ClearContents
Sheets("lain").Select
Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
Range(Range("g8"), Range("g8")).ClearContents
Sheets("kas").Select
Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
Range(Range("g8"), Range("g8")).ClearContents
' non-aktifkan fitur screen update agar vba berjalan lebih cepat
Application.ScreenUpdating = False
' pertama, aktifkan sheet input
Sheets("Input").Select
' tentukan lokasi header untuk tanggal
' letaknya di sheet input cell b8
Set hdTgl = Sheets("Input").Range("b8")
' tentukan lokasi range tanggel
' letaknya 1 baris di bawah header
' sampai dengan baris terakhir yang berisi data
Set rgTgl = Range(hdTgl.Offset(1, 0), hdTgl.End(xlDown))
' lakukan loop terhadap range tanggal
For Each cTgl In rgTgl
' ambil nilai baris dari setiap tanggal dengan menggunakan perintah .Row
rData = cTgl.Row
' lakukan loop untuk kolom J (kolom nomer 10) sampai R (kolom nomer
18)
For c = 21 To 26
' periksa kondisi apakah perpotongan antara baris & kolom
bernilai 0 (nol) atau tidak
If Cells(rData, c).Value <> 0 Then
' jika perpotongan baris & kolom <> 0 (nol)
' ambil nilai di baris 7 pada kolom tersebut menggunakan
perintah .Value
' cara menunjuknya adalah menggunakan perintah Cells(7, c)
' nilai ini adalah nama setiap sheet yang akan menerima
distribusi data
' dan disimpan dalam variabel yang bernama NamaSheet
NamaSheet = Cells(7, c).Value
' panggil sheet tersebut sesuai dengan namanya
Sheets(NamaSheet).Select
' pergi ke cell B10, karena ini adalah header tanggal dari
setiap sheet
Range("b10").Select
' periksa apakah 1 baris di bawah header tanggal tersebut
ada datanya atau tidak
If ActiveCell.Offset(1, 0) = "" Then
' jika 1 baris di bawah header tidak ada datanya, maka
' dari header turun 1 baris ke bawah menggunakan
perintah .Offset(1, 0)
ActiveCell.Offset(1, 0).Select
' karena ini adalah data pertama, maka
' beri nilai 1 pada kolom nomer bukti
' letaknya adalah 1 kolom di sebelah kanan dari cell
yang aktif
' untuk menunjuk lokasinya menggunakan perintah
.Offset(, 1)
'ActiveCell.Offset(, 1).Value = 1 <<< jk di sheet urut
(ada 2 item yanghrs d
ActiveCell.Offset(, 1).Value =
Sheets("Input").Cells(rData, 3).Value
' selain itu
Else
' kalo sampai di sini, berarti di sheet tersebut sudah
ada datanya
' dari header turun ke data yang paling bawah
menggunakan perintah .End(xlDown)
' lalu turun lagi 1 baris ke baris yang kosong dengan
menggunakan perintah .Offset(1, 0)
ActiveCell.End(xlDown).Offset(1, 0).Select
' karena sebelumnya sudah ada data, maka nomer bukti
adalah <<<< nomor di sheet
' nomer bukti pada baris di atasnya ditambah dengan
nilai 1
'ActiveCell.Offset(, 1).Value = ActiveCell.Offset(-1,
1).Value + 1 <<< jk di sheet urut
ActiveCell.Offset(, 1).Value =
Sheets("Input").Cells(rData, 3).Value
' yang ini adalah akhir dari pemeriksaan apakah di sheet
yang dituju sudah ada datanya atau belum
End If
' mulai dari sini kita akan bekerja dengan cell yang aktif
pada sheet yang sudah terpilih
' untuk itu selalu dibuka dengan perintah With nama_object
' dan selalu ditutup dengan End With
With ActiveCell
' pada aktif cell diisi dengan tanggal
' nilainya berasal dari sheet Input, terletak pada
perpotongan baris dengan kolom 2 (kolom B)
.Value = Sheets("Input").Cells(rData, 2).Value
' 2 kolom di sebelah kanan aktif cell diisi dengan
nilai yang berasal dari
' perpotongan antara baris dengan kolom (mulai kolom 10
atau kolom J sampai kolom 18 atau kolom R)
'.Offset(, 2).Value = Sheets("Input").Cells(rData,
c).Value <<< untuk menampilak kolom d,k,d/k
' 2 kolom di sebelah kanan aktif cell diisi dengan
Uraian Transaksi
' nilainya berasal dari sheet Input, terletak pada
perpotongan baris dengan kolom 4 (kolom d)
.Offset(, 2).Value = Sheets("Input").Cells(rData,
5).Value
'.Offset(, 2).Value = Sheets("Input").Cells(rData,
7).Value & " - " & Sheets("Input").Cells(rData, 5).Value
'.Offset(, 7).Value = Sheets("input").Cells(rData,
10).Value
'.Offset(, 8).Value = Sheets("input").Cells(rData,
11).Value
'.Offset(, 9).Value = Sheets("input").Cells(rData,
12).Value
'.Offset(, 10).Value = Sheets("input").Cells(rData,
13).Value
' sekarang kita melakukan pengujian data terhadap kode
yang tercantum dalam kolom nama baris
' dan perpotongan baris tanggal
' kondisi pertama jika kode adalah D/K
If Sheets("Input").Cells(rData, c) = "D/K" Then
' maka nilai kolom Masuk & kolom Keluar pada sheet
yang terpilih
' diisi dengan nilai yang berasal dari kolom Jumlah
pada sheet Input
' untuk menunjuk kolom masuk yang terletak 3 kolom
di sebelah kanan cell aktif
' menggunakan perintah .Offset(, 3)
.Offset(, 3).Value = Sheets("Input").Cells(rData,
9).Value
' untuk menunjuk kolom masuk yang terletak 4 kolom
di sebelah kanan cell aktif
' menggunakan perintah .Offset(, 4)
.Offset(, 4).Value = Sheets("Input").Cells(rData,
9).Value
' lakukan pengujian dengan kondisi berikutnya yaitu
kode adalah D
ElseIf Sheets("Input").Cells(rData, c) = "D" Then
' pada kondisi ini yang diisi dengan nilai adalah
kolom Masuk
.Offset(, 3).Value = Sheets("Input").Cells(rData,
9).Value
' sedangkan kolom keluar diisi dengan nilai 0 (nol)
.Offset(, 4).Value = 0
' selain itu, berarti kode adalah K
Else
' pada kondisi ini kolom Masuk diisi dengan 0 (nol)
.Offset(, 3).Value = 0
' sedangkan kolom Keluar diisi dengan nilai yang
berasal dari sheet Input
.Offset(, 4).Value = Sheets("Input").Cells(rData,
9).Value
' ini adalah penutup dari pengecekan kode
End If
' sekarang dilakukan pengujian untuk menenukan nilai
Saldo Akhir
' jika cell aktif ada di baris 11, berarti ini adalah
data pertama
If ActiveCell.Row = 11 Then
' maka Saldo akhir adalah nilai pada cell g7 + e11
- f11
Saldo = Range("g7").Value + Range("e11").Value -
Range("f11").Value
' selain itu, berarti ini bukanlah data pertama
Else
' nilai Saldo akhir berasal dari saldo akhir pada 1
baris di atasnya
' letaknya adalah 1 baris di atas cell aktif
' dan 6 kolom di sebelah kanan cell aktif
' untuk menunjuknya digunakan perintah .Offset(-1,
5)
' ditambah nilai pada kolom Masuk
' letaknya 4 kolom di sebelah kanan cell aktif
' untuk menunjuknya digunakan perintah .Offset(, 3)
' dikurangi nilai kolom Keluar
' letaknya 5 kolom di sebelah kanan cell aktif
' untuk menunjuknya digunakan perintah .Offset(, 4)
Saldo = .Offset(-1, 5).Value + .Offset(, 3).Value -
.Offset(, 4).Value
' ini adalah penutup dari perhitungan Saldo Akhir
End If
' pada cell g8 & kolom Saldo diisi dengan nilai Saldo
Akhir yang sudah diperoleh sebelumnya
Range("g8").Value = Saldo
.Offset(, 5).Value = Saldo
' ini adalah penutup dari blok With ActiveCell
End With
' ini adalah penutup dari blok pemeriksaan kode transaksi
End If
' panggil kembali sheet Input
Sheets("Input").Select
' periksa kolom berikutnya
Next c
' periksa baris tanggal berikutnya
Next cTgl
' aktifkan kembali fitur screen update
Application.ScreenUpdating = True
' ini adalah akhir dari prosedur Distribusi ke setiap sheet
End Sub
Sub BPP()
Dim hdTgl, rgTgl, cTgl As Range
Dim rData, c As Long
Dim NamaSheet As String
Dim Saldo As Double
Sheets("bpp").Select
Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
Range(Range("g8"), Range("g8")).ClearContents
Application.ScreenUpdating = False
Sheets("Input").Select
Set hdTgl = Sheets("Input").Range("b8")
Set rgTgl = Range(hdTgl.Offset(1, 0), hdTgl.End(xlDown))
For Each cTgl In rgTgl
rData = cTgl.Row
For c = 27 To 27
If Cells(rData, c).Value <> 0 Then
NamaSheet = Cells(7, c).Value
Sheets(NamaSheet).Select
Range("b10").Select
If ActiveCell.Offset(1, 0) = "" Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(, 1).Value =
Sheets("Input").Cells(rData, 3).Value
Else
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveCell.Offset(, 1).Value =
Sheets("Input").Cells(rData, 3).Value
End If
With ActiveCell
.Value = Sheets("Input").Cells(rData, 2).Value
.Offset(, 4).Value = Sheets("Input").Cells(rData,
5).Value
.Offset(, 2).Value = Sheets("input").Cells(rData,
7).Value
Dim rng As Range, lRec As Long '<<<<<<<<< Baru untuk bpp
Set rng = Sheet7.Range("b10").CurrentRegion '<<<<<<< baru
With rng
lRec = .Rows.Count - 1
If lRec > 0 Then
With .Resize(lRec, 1).Offset(1, 3)
'.Formula = "=LEFT(f11,FIND("" - "",f11&"" - - "",FIND("" -
"",f11&"" - "")+1)-1)"
.Formula = "=LEFT(f11,FIND("" _ "",f11&"" _ _ "")-1)"
.Parent.Calculate
.Value = .Value
End With
End If
End With
If Sheets("Input").Cells(rData, c) = "D/K" Then
.Offset(, 5).Value = Sheets("Input").Cells(rData,
9).Value
.Offset(, 6).Value = Sheets("Input").Cells(rData,
9).Value
ElseIf Sheets("Input").Cells(rData, c) = "D" Then
.Offset(, 5).Value = Sheets("Input").Cells(rData,
9).Value
.Offset(, 6).Value = 0
Else
.Offset(, 5).Value = 0
.Offset(, 6).Value = Sheets("Input").Cells(rData,
9).Value
End If
If ActiveCell.Row = 11 Then
Saldo = Range("i7").Value + Range("g11").Value -
Range("h11").Value
Else
Saldo = .Offset(-1, 7).Value + .Offset(, 5).Value -
.Offset(, 6).Value
End If
Range("i8").Value = Saldo
.Offset(, 7).Value = Saldo
End With
End If
Sheets("Input").Select
Next c
Next cTgl
Application.ScreenUpdating = True
End Sub
Sub up()
Dim hdTgl, rgTgl, cTgl As Range
Dim rData, c As Long
Dim NamaSheet As String
Dim Saldo As Double
Sheets("up").Select
Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
Range(Range("g8"), Range("g8")).ClearContents
'Sheets("pajak").Select
'Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
'Range(Range("g8"), Range("g8")).ClearContents
Application.ScreenUpdating = False
Sheets("Input").Select
Set hdTgl = Sheets("Input").Range("b8")
Set rgTgl = Range(hdTgl.Offset(1, 0), hdTgl.End(xlDown))
For Each cTgl In rgTgl
rData = cTgl.Row
For c = 28 To 28
If Cells(rData, c).Value <> 0 Then
NamaSheet = Cells(7, c).Value
Sheets(NamaSheet).Select
Range("b10").Select
If ActiveCell.Offset(1, 0) = "" Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(, 1).Value =
Sheets("Input").Cells(rData, 3).Value
Else
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveCell.Offset(, 1).Value =
Sheets("Input").Cells(rData, 3).Value
End If
With ActiveCell
.Value = Sheets("Input").Cells(rData, 2).Value
.Offset(, 2).Value = Sheets("Input").Cells(rData,
5).Value
.Offset(, 7).Value = Sheets("input").Cells(rData,
10).Value
.Offset(, 8).Value = Sheets("input").Cells(rData,
11).Value
.Offset(, 9).Value = Sheets("input").Cells(rData,
13).Value
.Offset(, 10).Value = Sheets("input").Cells(rData,
15).Value
.Offset(, 11).Value = Sheets("input").Cells(rData,
17).Value
If Sheets("Input").Cells(rData, c) = "D/K" Then
.Offset(, 3).Value = Sheets("Input").Cells(rData,
9).Value
.Offset(, 4).Value = Sheets("Input").Cells(rData,
9).Value
ElseIf Sheets("Input").Cells(rData, c) = "D" Then
.Offset(, 3).Value = Sheets("Input").Cells(rData,
9).Value
.Offset(, 4).Value = 0
Else
.Offset(, 3).Value = 0
.Offset(, 4).Value = Sheets("Input").Cells(rData,
9).Value
End If
If ActiveCell.Row = 11 Then
Saldo = Range("g7").Value + Range("e11").Value -
Range("f11").Value
Else
Saldo = .Offset(-1, 5).Value + .Offset(, 3).Value -
.Offset(, 4).Value
End If
Range("g8").Value = Saldo
.Offset(, 5).Value = Saldo
End With
End If
Sheets("Input").Select
Next c
Next cTgl
Application.ScreenUpdating = True
End Sub
Sub Pajak()
Dim hdTgl, rgTgl, cTgl As Range
Dim rData, c As Long
Dim NamaSheet As String
Dim Saldo As Double
Sheets("pajak").Select
Range(Range("b11"), Range("b11").End(xlDown).End(xlToRight)).ClearContents
Range(Range("g8"), Range("g8")).ClearContents
Application.ScreenUpdating = False
Sheets("Input").Select
Set hdTgl = Sheets("Input").Range("b8")
Set rgTgl = Range(hdTgl.Offset(1, 0), hdTgl.End(xlDown))
For Each cTgl In rgTgl
rData = cTgl.Row
For c = 29 To 29
If Cells(rData, c).Value <> 0 Then
NamaSheet = Cells(7, c).Value
Sheets(NamaSheet).Select
Range("b10").Select
If ActiveCell.Offset(1, 0) = "" Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(, 1).Value =
Sheets("Input").Cells(rData, 3).Value
Else
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveCell.Offset(, 1).Value =
Sheets("Input").Cells(rData, 3).Value
End If
Dim rng As Range, lRec As Long '<<<<<<<<< Baru untuk bpp
Set rng = Sheet10.Range("b10").CurrentRegion '<<<<<<< baru
With rng
lRec = .Rows.Count - 1
If lRec > 0 Then
With .Resize(lRec, 1).Offset(1, 8)
.Formula = "=IF(""PPh
21""=VLOOKUP(C11,Input!$C$10:$AC$2494,6,FALSE),E11-F11,0)"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(1, 9)
.Formula = "=IF(""PPh
22""=VLOOKUP(C11,Input!$C$10:$AC$2494,6,FALSE),E11-F11,0)"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(1, 10)
.Formula = "=IF(""PPh
23""=VLOOKUP(C11,Input!$C$10:$AC$2494,6,FALSE),E11-F11,0)"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(1, 11)
.Formula =
"=IF(""PPN""=VLOOKUP(C11,Input!$C$10:$AC$2494,6,FALSE),E11-F11,0)"
.Parent.Calculate
.Value = .Value
End With
With .Resize(lRec, 1).Offset(1, 12)
.Formula = "=IF(""PPh Ps 4 ayt
2""=VLOOKUP(C11,Input!$C$10:$AC$2494,6,FALSE),E11-F11,0)"
.Parent.Calculate
.Value = .Value
End With
End If
End With
With ActiveCell
.Value = Sheets("Input").Cells(rData, 2).Value
.Offset(, 2).Value = Sheets("Input").Cells(rData,
5).Value
'.Offset(, 8).Value = Sheets("input").Cells(rData,
10).Value
'.Offset(, 9).Value = Sheets("input").Cells(rData,
11).Value
'.Offset(, 10).Value = Sheets("input").Cells(rData,
13).Value
'.Offset(, 11).Value = Sheets("input").Cells(rData,
15).Value
'.Offset(, 12).Value = Sheets("input").Cells(rData,
17).Value
If Sheets("Input").Cells(rData, c) = "D/K" Then
.Offset(, 3).Value = Sheets("Input").Cells(rData,
9).Value
.Offset(, 4).Value = Sheets("Input").Cells(rData,
9).Value
ElseIf Sheets("Input").Cells(rData, c) = "D" Then
.Offset(, 3).Value = Sheets("Input").Cells(rData,
9).Value
.Offset(, 4).Value = 0
Else
.Offset(, 3).Value = 0
.Offset(, 4).Value = Sheets("Input").Cells(rData,
9).Value
End If
If ActiveCell.Row = 11 Then
Saldo = Range("g7").Value + Range("e11").Value -
Range("f11").Value
Else
Saldo = .Offset(-1, 5).Value + .Offset(, 3).Value -
.Offset(, 4).Value
End If
Range("g8").Value = Saldo
.Offset(, 5).Value = Saldo
End With
End If
Sheets("Input").Select
Next c
Next cTgl
Application.ScreenUpdating = True
End Sub
