Total Amount by Cost Code Group.
2008/10/8 Safri Ishak <safri.ishak@gmail.com>
Salam Makdo,
kalau ada waktu dan mau coba makro, silahkan download the attached excel file,
mudah2an nggak sakit kepala ... he he.
Saya mengharapkan Mbak Siti dan pakar lain mau melakukan bedah makro agar menjadi
lebih efisien dan efektif, terima kasih sebelumnya.
Pada sheet pertama (group Cost Code) saya tambahkan MIN & MAX Group Code,
Kode Batas Awal dan Kode Batas Akhir.
Gunanya untuk me-reset property Spinner 1 button.
Kemudian pada sheet kedua (DATA) saya beri nama "GroupPengeluaran"
untuk tempat Group yang dipilih (cells D23) dan nama "JumlahRp" untuk
Jumlah ( RP ) di cells D25.
Maksudnya agar makro merefer ke nama cells seandainya ada penambahan atau
pengurangan data.
Pada tombol Spinner 1 untuk memilih Cost Code Group saya assign macro
"spnGROUP", sehingga kalau Cost Code Group dipilih (di click) maka
Jumlah ( RP ) akan dihitung kembali.
Bedah Makro:
spnGroup merupakan procedure utama dalam makro ini yaitu untuk
menghitung ulang seandainya terjadi perubahan dari Cost Code Group yang dipilih
melalui tombol Spinner 1 atau ada data yang berubah atau ditambah.
Sub spnGROUP()
'ON CLICK SPINNER 1
Dim
intROW
As Long
Dim intGROUP
As Integer
Dim
blnOK
As Boolean
Dim
dblBATASAWAL
As Double
Dim
dblBATASAKHIR As
Double
'GROUP
PENGELUARAN
Range("GroupPengeluaran").
intGROUP = Selection.Value
Range("JumlahRp").Select
Selection.Value = 0
'AMBIL
BATAS AWAL DAN BATAS AKHIR
With Sheets("group Cost Code")
blnOK = False 'ERROR FLAG
intROW = 5 'ROW DATA PERTAMA DALAM SHEET GROUP COST
CODE
Do While Trim(.Cells(intROW, 2))
<> Empty
'CHECK GROUP CODE
'ERROR GROUP TIDAK ADA DALAM GROUP COST CODE
If intGROUP
< .Cells(intROW, 2) Then
Exit Do
'GROUP OK
ElseIf
intGROUP = .Cells(intROW, 2) Then
blnOK = True
dblBATASAWAL = .Cells(intROW, 3)
dblBATASAKHIR = .Cells(intROW, 4)
Exit Do
End If 'CHECK GROUP CODE
'NEXT
intROW =
intROW + 1
Loop 'AMBIL BATAS AWAL DAN BATAS AKHIR
End With 'AMBIL
BATAS AWAL DAN BATAS AKHIR
'GROUP TIDAK ADA DALAM GROUP COST CODE
If blnOK = False Then
Exit Sub
End If 'GROUP
TIDAK ADA DALAM GROUP COST CODE
'HITUNG
JUMLAH
Range("JumlahRp").Select
intROW = 6 'ROW DATA PERTAMA DALAM SHEET DATA
Do While Trim(Cells(intROW, 3)) <> Empty
'DATA VALIDATION
blnOK = True
'COST CODE
If IsNumeric(Cells(intROW, 3)) =
False Then
blnOK =
False
End If 'COST CODE
'AMOUNT
If IsNumeric(Cells(intROW, 4)) =
False Then
blnOK =
False
End If 'AMOUNT
'DATA NUMERIC
If blnOK = True Then
'JUMLAH
If
Cells(intROW, 3) < dblBATASAWAL _
Or
Cells(intROW, 3) > dblBATASAKHIR Then
Else
'DATA DALAM RANGE GROUP COST CODE
Selection.Value = Selection.Value + Cells(intROW, 4) 'JUMLAH
End If 'JUMLAH
End If 'DATA NUMERIC
'NEXT
intROW = intROW + 1
Loop 'HITUNG JUMLAH
'END OF ON CLICK SPINNER 1
End Sub
Ceritanya cost code yang dipilih divalidasi, kalau cost code OK maka diambil
batas awal dan batas akhir.
Kemudian data dibaca satu per satu sampai habis (data di akhiri dengan paling
sedikit satu row yang kosong).
Setiap data yang dibaca divalidasi, data yang diterima adalah data yang
sifatnya numeric. Kalau data OK akan dilanjutkan dengan memilah data
berdasarkan batas awal dan batas akhir, untuk data yang masuk dalam range, maka
nilai rupiahnya akan ditambahkan ke Jumlah ( RP ).
Procedure yang kedua, iniSPINNER1 procedure digunakan untuk me-reset property
Spinner 1 button, lalu menghitung ulang Jumlah ( RP ) dengan memenggil spnGROUP
procedure.
Sub iniSPINNER1()
'SPINNER 1 INITIALIZATION
'Macro recorded 10/6/2008 by Safri Ishak
Dim
intGROUPMIN
As Integer
Dim
intGROUPMAX
As Integer
'GROUP
CODE
Sheets("group Cost Code").Select
'MINIMUM
Range("GroupCodeMIN").Select
intGROUPMIN = Selection.Value
'MAXIMUM
Range("GroupCodeMAX").Select
intGROUPMAX = Selection.Value
'SPINNER
1 CONTROL
Sheets("DATA").Select
ActiveSheet.Shapes("Spinner 1").Select
With Selection
.Value = intGROUPMIN
.Min = intGROUPMIN
.Max = intGROUPMAX
.SmallChange = 1
.LinkedCell =
"GroupPengeluaran"
.Display3DShading = True
End With 'SPINNER
1 CONTROL
Range("GroupPengeluaran").
Selection.Value = intGROUPMIN
spnGROUP
'END OF SPINNER 1 INITIALIZATION
End Sub
Ceritanya property Spinner 1 button dirubah berdasarkan MIN dan MAX Cost Code
Group.
Seperti yang terlihat di comment baris ke dua, statement awal dari procedure
ini saya buat dengan menggunakan fasilitas "Record Macro", no big
deal ..... he he.
Procedure yang ketiga Auto_Open procedure yang secara otomatis akan di execute
pada waktu file di buka.
Auto_Open akan memanggil iniSPINNER1 (initial property) yang sekaligus akan
menjalankan spnGROUP (hitung jumlah).
Sub Auto_Open()
'AUTO OPEN
'SPINNER
1 INITIALIZATION
iniSPINNER1
'END OF AUTO OPEN
End Sub
Untuk mengantisipasi perubahan data, didalam sheet DATA saya tambahkan private
procedure berikut ini:
Private Sub Worksheet_Change(ByVal Target As
Range)
'ADA PERUBAHAN DATA DI
WORKSHEET
'ALAMAT CELL DATA YANG BERUBAH DISIMPN DI TARGET ADDRESS
'TAGET ADDRESS $column$row-number
'DATA CHANGE ON COLUMN C OR D
If Left(Target.Address, 2) = "$C" _
Or Left(Target.Address, 2) = "$D" Then
'DISABLE EVENTS
Application.EnableEvents = False
'ON CLICK SPINNER 1
spnGROUP
'ENABLE EVENTS
Application.EnableEvents = True
End If 'DATA
CHANGE ON COLUMN C OR D
'END OF ADA PERUBAHAN DATA
DI WORKSHEET
End Sub
Yang terakhir seandainya ada perubahan Cost Code Group, saya tambahkan private
procedure berikut ini:
Private Sub Worksheet_Change(ByVal Target
As Range)
'ADA PERUBAHAN DATA DI
WORKSHEET
'ALAMAT CELL DATA YANG BERUBAH DISIMPN DI TARGET ADDRESS
'TAGET ADDRESS $column$row-number
'DATA CHANGE ON COLUMN B OR C OR D
If Left(Target.Address, 2) = "$B" _
Or Left(Target.Address, 2) = "$C" _
Or Left(Target.Address, 2) = "$D" Then
'DISABLE EVENTS
Application.EnableEvents = False
'SPINNER 1 INITIALIZATION
iniSPINNER1
'ENABLE EVENTS
Application.EnableEvents = True
End If 'DATA
CHANGE ON COLUMN B OR C OR D
'RETURN
TO THE ORIGINAL SHEET
Sheets("group Cost Code").Select
'END OF ADA PERUBAHAN DATA DI WORKSHEET
End Sub
Sekali lagi mudah2an tidak bikin bingung atau sakit kepala, namanya juga
variasi boleh dipakai boleh tidak ..... he he.
--
Thank you and regards,
Safri
www.tb512.com my virtual home
www.tebetbarat.com Tebet
Business Directory consists of
addresses and phone numbers of favorite restaurants, traditional markets,
hotels, offices, schools, super markets, malls, automotive, gardens, flowers,
cakes, advertising, computers, salons, barber shops, cosmetics, banks,
apartments etc.
Originally it was compiled for personal purposes and then published to the
internet as a gateway to search business directory and websites in Tebet and
surrounding area.
2008/10/4 makdo marbun <banten7003@yahoo.com>
Salam para suhu
excelmaniawan dan excelmaniawati!
Saya member XL-mania
pasif, selama ini ngikuti problem solving yang terjadi dari file file yang
sering dikirim dari member yang ada .....ternyata memang bermanfaat
buuenar untuk membantu pekerjaan saya...makasih ya XL-Mania terutama untuk
moderatornya
buat sang Moderator Minta
ijin untuk di Posting dalam Mailist ini...
Belakangan saya ada
problem sedikit, file terlampir dari saya . bagai mana Caranya mencari
Penjumlahan berdasarkan Group Cost Code....?
buat yang bergelut di
bidang Keuangan Bantuin saya doong...
salam
Makdo
Tebet
Business Directory Alamat Usaha Kita
Free Posting IKLAN GRATIS, send your name, address,
telephone, email id, website and brief description of your business to AdminTebetbarat.com
More information about
www.TB512.com Click HERE.