Hai Faisal, File terlampir memiliki kondisi sebagai berikut : >> Area Kriteria : 1. header kriteria di baris 1 yang harus sama dengan nama header terpilih di tabel data. 2. area penulisan kriteria pada baris 2 sampai baris 8 3. area penulisan kriteria dimulai pada kolom B dan kolom A harus tetap kosong kecuali cell A1 yang berisi header No dari tabel data 4. area kriteria dilokalisir dengan adanya 8 baris kosong pada sebuah kolom setelah kolom terkanan area kriteria
>> Area input
1. Input berupa pilihan kolom kriteria yang akan digunakan
2. Input menggunakan fitur Data validation List dengan daftar item yang
merujuk range J1:J6
3. Item-item dalam range J2:J5 harus sama dengan nama kolom terpilih dalam
tabel data
4. Cell bantu posisi offset kolom terletak pada cell H2. Pelihara formula
pada cell H2 dengan baik.
5. Pengubahan isi cell input akan memicu proses filter (memanfaatkan event
change milik worksheet)
6. Jika tidak akan menggunakan kolom kriteria, maka pilihlah item [Semua
Data]
7. Jika akan menggunakan seluruh kriteria, maka pilihlah item [Seluruh
Kriteria].
8. Pelajari lebih lanjut karakteristik advanced filter agar dapat menyusun
kriteria dengan baik ketika memilih opsi seluruh kriteria
>> Area data
1. Header data berupa 1 baris yang terletak di baris ke 10 dan memenuhi
kaidah database tentang header data
2. Data dimulai pada baris ke-11 dan memenuhi kaidah database tentang
record data
Prosedur event change milik worksheet diberi script berikut :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCriteria As Range 'var range kriteria sesuai pilihan user
Dim lRows As Long 'jumlah baris kriteria beserta headernya
Dim lOff As Long 'nilai offset kolom untuk mencapai kolom
kriteria terpilih dari kolom A
With Application 'pada aplikasi
.ScreenUpdating = False 'turn off update
tampilan
.EnableEvents = False 'turn off event
.DisplayAlerts = False 'turn off kecerewetan
excel minta konfirmasi
.Calculation = xlCalculationAutomatic 'paksa agar kalkulasi
automatic
End With 'selesai aplikasi
With Target 'pada cell yang berubah nilai
If .Count = 1 Then 'cek jumlah cell yang
berubah nilai
'yup... cuma 1 cell yang berubah
If .Address = "$G$2" Then 'cek alamat cell yang
berubah nilai
'yup... alamatnya cocok
lOff = .Offset(0, 1).Value 'simpan nilai
offset kolom
Select Case lOff 'berdasar nilai
offset kolom
Case 0 To 4 'semua data atau sebuah kolom kriteria
terpilih saja
'definisikan kolom kriteria (basis : range a1:a8)
Set rngCriteria = Range("a1:a8").Offset(0, lOff)
'hitung jumlah baris isi kriteria (termasuk baris
header)
lRows =
Application.WorksheetFunction.CountA(rngCriteria)
'set ulang area kriteria terpilih
Set rngCriteria = rngCriteria.Resize(lRows)
Case Else 'seluruh kriteria akan digunakan
'set seluruh area kriteria
Set rngCriteria = Range("a1").CurrentRegion
End Select
'proses filter dengan advanced filter
Range("a10").CurrentRegion.AdvancedFilter xlFilterInPlace,
rngCriteria
End If 'selesai blok cek alamat
End If 'selesai blok cek jumlah
cell yang berubah nilai
End With 'selesai kerja pada cell yang
berubah
With Application 'pada aplikasi
.EnableEvents = True 'turn on event
.ScreenUpdating = True 'turn on update tampilan
.DisplayAlerts = True 'turn on kecerewetan excel minta
konfirmasi
End With 'selesai aplikasi
End Sub
Selamat menikmati liburan.
Wassalam,
Kid.
2012/12/22 Faisal Hasman <revolter_ic...@yahoo.com>
> **
>
>
> dear mailing excel
>
> sebelumnya hal hal ini pernah dibahas
> oleh pak hendrik... dengan file contoh FILTER BLOKKOTA
> namun setelah saya utak atik
> nda bisa jalan sesuai dengan file sample
> yangsaya attach
> mungkin karena macrox tidak mendukung
> karena saya mau memfilter
> dengan beberapa kriteria lagi
> yaitu, bentuk usaha, dusun, kelurahan/desa dan
> kecamatan
>
> mungkin bisa dibantu memecahkan masalah ini
> kalo bisa macro filter blokkotax dijelaskan juga
>
> trima kasih
>
>
>
re-DATA USAHA 2012.xlsm
Description: Binary data
