menghemat satu baris, hasilnya sama aja kan mbak ? emang melanggar aturan ya ? saya terbiasa pakai yg seperti itu dg refresh r = 0 di awal code,... he he kebiasaan buruk kali ye
From: STDEV(i) <[email protected]>
To: [email protected]
Sent: Tue, June 29, 2010 8:32:16 AM
Subject: Re: [belajar-excel] Modifikasi Macro
waduh.. ada salah agak "fatal-atraction" nih..
(untung pak danan kok belum sempat "protest" ya.....)
di dalam procedure FiterRekap (ada di Module Sheet 4 /"Rekap_II" )
ada Looping tertulis spt ini
For i = 1 To DatRows
If LookupKolom(i).Text = KRITE_1 Then
If LookupKolom2(i).Text = KRITE_2 Then
r = r + 1
vHax = vHax + TabelData(r, 11).Value
vKui = vKui + TabelData(r, 12).Value
vXtl = vXtl + TabelData(r, 18).Value
End If
End If
Next i
index baris dengan memanfaatkan variable r itu salah;
seharusnya index baris atas cell yg dirujuk menggunakan variable i
(yaitu integer pencacah / counter Loop).
koreksinya menjadi seperti ini :
For i = 1 To DatRows
If LookupKolom(i).Text = KRITE_1 Then
If LookupKolom2(i).Text = KRITE_2 Then
vHax = vHax + TabelData(i, 11).Value
vKui = vKui + TabelData(i, 12).Value
vXtl = vXtl + TabelData(i, 18).Value
End If
End If
Next i
Terlampr file produksi.xls yg sudah dikoreksi, sekalian ada beberapa modifikasi
misalnya report selain ditulis subtotalnya saja, juga ditulis rinciannya di tabel lain.
rgds,
-ctv-
'---------------------
2010/6/27 STDEV(i) <[email protected]>
Ysh Pak Danan,
Mudah mudahan tanggapan ini belum terlambat, berhubung saat-saat ini
siti jarang sekali mendapat kesempatan koneksi internet.
Pada workbook terlampir, siti membuat sheet baru (Rekap II);
nama sheet ini bebas boleh diubah dengan nama lain.
Membuat rekapitulasi seperti yg dimaksud oleh pak Danan akan menjadi mudah
kalau kita setiap saat dapat membuat DAFTAR UNIQUE dari data Tanggal Giling
dan Data Nomor Petak, yg merupakan extract / perasan dari data yg ada
di sheet DATA.
Untuk keperluan itu kita membuat FUNGSI LOUV (List of Unique Values)
yaitu sebuah UDF yg dapat menyediakan ARRAY daftar unique yg diambil dari
sebuah KOLOM Range.
Untuk membuat REKAP nya sendiri, sheet "Rekap II" kita beri struktur tabel spt ini
Tombol RefreshCombo untuk mengisi kembali items di kedua combobox
(berisi pilihan kriteria). Perlu di refresh karena setiap item dropdownlist tsb
kadang kadang dilupakan oleh comboboxnya. (diisi dari hasil Fungsi LOUV;
makanya isinya dinamis mengikuti data yg ada di tabel sheet "data")
Dua Combobox kriteria hanya SATU yg akan berfungsi .
Jika satu sudah ditentukan isinya, combo lainnya akan kosong.
Tombol Rekap untuk mengerjakan Subtotal sesuai Kriteria yg ditentukan.
Listing Code untuk pekerjaan ini siti tulis di module Sheet Rekap II
Kita cantumkan di badan email ini karena, saya khawatir nanti pada saat ada
kesempatan terkoneksi ke internet, saya tidak dapat melampirkan workbooknya.
(misal hanya bisa konek melalui 'mobile device')
Program ini hanya menghasilkan Baris SUbTotal saja (tidak merinci records yg
sesuai kriteria seperti pada sheet "Rekap Per Petak"
Mudah-mudahan tidak terlalu jauh dari kehendak pak Danan;
tetapi jika diperlukan perubahan / hal lain, tentu dapat didisksikan di milis ini.
Private Sub FilterRekap(Combox As ComboBox)
' Rekap Subtotal sesuai kriteria
Dim TabelData As Range
Dim DatTanggal As Range
Dim DatNrPetak As Range
Dim Combox2 As ComboBox
Dim KRITE_1
Dim KRITE_2
Dim LookupKolom As Range
Dim LookupKolom2 As Range
Dim MaxKrite As Integer
Dim vHax As Double
Dim vKui As Double
Dim vXtl As Double
Dim vRdm As Double
Dim DatRows As Long
Dim r As Long, n As Integer, i As Long
Set TabelData = Sheets("Data").Range("A4").CurrentRegion
DatRows = TabelData.Rows.Count - 1
Set DatNrPetak = TabelData.Offset(1, 6).Resize(DatRows, 1)
Set DatTanggal = DatNrPetak.Offset(0, 13)
Set TabelData = TabelData.Offset(1, 0)
If Combox = Cbo_Tanggal Then ' kriteria = Tgl Giling
Set Combox2 = Cbo_NrPetak
Set LookupKolom = DatTanggal
Set LookupKolom2 = DatNrPetak
KRITE_1 = Cbo_Tanggal.Value
MaxKrite = Cbo_Tanggal.ListCount
ElseIf Combox = Cbo_NrPetak Then
Set Combox2 = Cbo_Tanggal
Set LookupKolom = DatNrPetak
Set LookupKolom2 = DatTanggal
KRITE_1 = Cbo_NrPetak.Value
MaxKrite = Cbo_NrPetak.ListCount
End If
For n = 1 To Combox2.ListCount
Combox2.ListIndex = n - 1
KRITE_2 = Combox2.Value
r = 0
vHax = 0
vKui = 0
vRdm = 0
vXtl = 0
For i = 1 To DatRows
If LookupKolom(i).Text = KRITE_1 Then
If LookupKolom2(i).Text = KRITE_2 Then
r = r + 1
vHax = vHax + TabelData(r, 11).Value
vKui = vKui + TabelData(r, 12).Value
vXtl = vXtl + TabelData(r, 18).Value
End If
End If
Next i
With Me.Range("B7")
.Cells(n, 1) = Cbo_NrPetak
.Cells(n, 2) = Cbo_Tanggal
.Cells(n, 3) = vHax
.Cells(n, 4) = vKui
.Cells(n, 5) = vXtl
.Cells(n, 6) = Round(vXtl / vKui * 100, 2)
.Cells(n, 6).NumberFormat = "#,##0.00"
End With
Next n
End Sub
'--------------------------------
wassalam
siti
2010/6/25 Rahagung Dananjoyo <[email protected]>
Yth. Para pakar Excel
Saya sangat terbantu dengan file hasil diskusi sebelumnya, pada email saya skrg ini ada beberapa modifikasi yang akan dilakukan, mohon bantuannya.
Data di file terlampir adalah sumber data yang akan diolah/direkap di sheet REKAP PER PETAK.
Pada sheet REKAP PER PETAK sudah ada form untuk filter berdasarkan nomer petak, kategori dan tgl giling. Data yang muncul dari filter tersebut adalah rincian data dari sheet Data dan dibawahnya ada nilai totalnya(Bisa dilihat di sheet REKAP PER PETAK).
Saya ingin menambahkan bentuk filter lain (mungkin perlu sheet baru? ).
Filter yang saya inginkan adalah data hasil filter sudah dalam bentuk totalnya saja.
Jadi misalnya filter untuk data tgl giling 5 Jun 2010, ketika di filter maka yg muncul adalah :
- total untuk nomer petak 1000 pada tgl 5 jun 2010
- total untuk nomer petak 1500 pada tgl 5 jun 2010
- total untuk nomer petak 200 pada tgl 5 jun 2010
- total untuk nomer petak 500 pada tgl 5 jun 2010
dst, berlaku untuk semua petak dalam tgl tersebut
Ketika saya filter untuk nomer petak 1000, maka yang muncul adalah :
- total nomer petak 1000 pada tgl 5 jun 2010
- total nomer petak 1000 pada tgl 6 jun 2010
- total nomer petak 1000 pada tgl 7 jun 2010
dst, berlaku untuk semua tgl giling
Data yg ditotal adalah Ha, Tebu (Kui), Kristal Sementara.
Rumus Total RDM adalah Total Kristal Sementara dibagi Total Tebu (Kui) dikali 100
(Data di file ini adalah data contoh, bukan data asli)
Terima kasih atas bantuan dan pencerahannya
