Hai Bagus,
File terlampir baru berisi prosedur DistKeSheet.
Dalam prosedur tersebut sudah ada berbagai bentuk rujukan tanpa harus
mengaktifkan (select atau activate) si object.
Pemasangan formula bisa langsung ke banyak range (beda kolom dan baris)
dengan tetap memegang kaidah absolute reference (pengaturan karakter $
dalam formual)
Harapannya, contoh satu prosedur tersebut diimplementasikan ke prosedur
lainnya.
Wassalam,
Kid.
2013/3/16 dhen.baguse <bagusejo...@yahoo.com>
> **
>
>
> 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 '
' ---------------------------- '
' diubah Kid, 2013-03-17
' nama prosedur
public Sub DistKeSheet()
' deklarasi header Tanggal, range Tanggal, & cell Tanggal
' tipe data adalah range karena yang akan diambil adalah object-nya
Dim hdTgl as range, rgTgl as range, 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 as long, 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
'langsung pasang formula untuk 9 kolom dengan referensi yang
diatur dengan $
'jika proses kalkulasi berat, maka sebelum proses ini,
'buat sebuah kolom bantu (satu blok formula seperti di atas)
berisi formula match bagian :
'MATCH($F10,Master!$B$4:$B$46,0)
'kemudian blok formula ini diganti dengan formula Index yang
bagian Match-nya merujuk
'ke kolom bantu tadi
'*** saat ini, dicoba langsung ke 9 kolom dulu saja ***
With .Resize(lRec, 9).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
endif
end with
'untuk membersihkan sheet
'nama sheet yang akan dibersihkan : bku,Tunai,bank,perjadin,lain,kas
'range yang akan dibersihkan di setiap sheet : range("g8") dan range
data mulai b11 kebawah dan kekanan
'variabel sheet yang akan diproses dan teks berupa daftar nama sheet
(beserta pemisahnya)
dim sht as worksheet
dim sShtName as string
'susun daftar nama sheet sebagai sebuah text disertai pemisah nama
sshtname=",bku,tunai,bank,perjadin,lain,kas," 'jadi setiap sheet
pasti diapit karakter koma dan semua huruf kecil
'loop setiap sheet dalam workbook
for each sht in thisworkbook.worksheets
if instr( sshtname, "," & lcase$(sht.name) & "," ) <> 0 then
'sht yang diproses dalam loop punya nama dalam daftar
sht.Range(Range("b11"),
Range("b11").End(xlDown).End(xlToRight)).ClearContents
sht.Range("g8").clearcontents
endif
next sht
' non-aktifkan fitur screen update agar vba berjalan lebih cepat
Application.ScreenUpdating = False
' 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 = Sheets("Input").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 Sheets("Input").Cells(rData, c).Value <> 0 Then
' simpan sheet sesuai namanya
set sht=Sheets(Sheets("Input").Cells(7, c).Value)
' simpan lokasi cell B10, karena ini adalah header tanggal
dari setiap sheet
set rng=sht.Range("b10")
' periksa apakah 1 baris di bawah header tanggal tersebut
ada datanya atau tidak
If lenb(rng.Offset(1, 0).value) = 0 Then 'data
pertamakah ?
'yup, baris penulisan adalah 2 baris setelah header
'set rng dengan lokasi kolom B
pada baris penulisan
set rng=rng.offset(2)
Else ' selain itu
' 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)
'alias turun sampai baris baru
set
rng=rng.End(xlDown).offset(1)
' 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
disimpan dalam variabel rng pada sheet terpilih
' untuk itu selalu dibuka dengan perintah With nama_object
dan selalu ditutup dengan End With
With rng
'tulis data nomor bukti di 1
kolom kanannya rng yang sudah merujuk ke baris penulisan
rng.offset(0,1).value=Sheets("Input").Cells(rData, 3).Value
' 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
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
' 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).value = "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).value = "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
Else ' selain itu, berarti kode adalah K
' 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 .Row = 11 Then
' maka Saldo akhir adalah nilai pada cell g7 + e11
- f11
Saldo = Range("g7").Value + Range("e11").Value -
Range("f11").Value
Else ' selain itu, berarti ini bukanlah data pertama
' 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
sht.Range("g8").Value = Saldo
.Offset(, 5).Value = Saldo
' ini adalah penutup dari blok With ActiveCell [variabel
rng]
End With
' ini adalah penutup dari blok pemeriksaan kode transaksi
End If
' 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
