Coba file terlampir Cara pakai : 0. Klik kanan -> pilih Filter Kolom 1. Blok data yang akan di filter (selalu hanya akan memproses baris pertama dari area pertama yang ter-select) 2. tulis kriterianya (lihat penjelasan pada dialog input yang ada) 3. tekan OK
Prosedur utama : FilterKolomSet
Public Sub FilterKolomSet(Optional bState As Boolean = False)
Dim rngArea As Range, rng As Range, vVal As Variant
Dim sKri As String, sPrefix As String, sSuffix As String
Dim lRes As Long, lKriType As Long, lDataType As Long
On Error Resume Next
With Application
.EnableEvents = False
.DisplayAlerts = False
Set rngArea = .InputBox( _
"Pilih range." & vbCrLf & "[baris pertama pada area
pertama yang di-filter]" _
, "Set Area", Selection.Address, Type:=8)
End With
If Err.Number <> 0 Then
GoTo Keluar
End If
Set rngArea = rngArea.Areas(1).Resize(1)
With rngArea
If .Columns.Count = 1 Then
GoTo Keluar
End If
sKri = InputBox("Tulis ekspresi kriterianya" & vbCrLf & vbCrLf &
"Contoh :" & vbCrLf & _
"<>1" & vbTab & vbTab & "(bukan bernilai numerik
1)" & vbCrLf & _
"=1" & vbTab & vbTab & "(bernilai numerik 1)" &
vbCrLf & _
"<>""Aku""" & vbTab & vbTab & "(bukan bernilai teks
'Aku')" & vbCrLf & _
"=""Aku""" & vbTab & vbTab & "(bernilai teks
'Aku')" & vbCrLf & vbCrLf & _
"jika dikosongkan, maka filter akan di-clear" &
vbCrLf & _
"kriteria blank adalah dengan nullstring" & vbCrLf
& _
"(seperti ="""" atau <>"""")", "Kriteria")
Application.ScreenUpdating = False
If LenB(sKri) = 0 Then
.EntireColumn.Hidden = False
GoTo Keluar
End If
sKri = Trim$(sKri)
If Right$(sKri, 1) = """" Then
lKriType = vbString
Else
lKriType = -1
End If
End With
For Each rng In rngArea
If Not rng.EntireColumn.Hidden Then
vVal = rng.Value
Select Case VarType(vVal)
Case vbString
vVal = """" & vVal & """"
lDataType = vbString
Case vbEmpty
vVal = """"""
lDataType = vbString
Case Else
lDataType = -1
End Select
If lDataType = lKriType Then
rng.EntireColumn.Hidden = (Evaluate("=1*(" & vVal & sSuffix
& sKri & ")") <> 1)
Else
rng.EntireColumn.Hidden = True
End If
End If
Next rng
Keluar:
Err.Clear
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Silakan dikembangkan. Mungkin lebih bagus jika inputan user menggunakan
userform.
hehehe... maaf, sudah cari di library untuk yang pake userform tapi gak
ketemu.
Daripada buat baru, mending diserahkan ke BeExceller untuk dikembangkan
masing-masing. Sukur-sukur bisa mengolah dengan banyak kriteria.
Karena prosedur ini adalah prosedur dasar yang dibuat tahun 2009, kalau ada
perbaikannya, mohon di-posting ke milis juga ya...
Wassalam,
Kid.
2012/9/19 Prazt Math <[email protected]>
> **
>
>
> Mohon maaf pertanyaannya malah kebalik karena saking bingungya, pertanyaan
> saya ulang:****
>
> Dear para suhu excell, ane mau minta bantuan pada para exceller tapi mohon
> maaf apabila sudah ada pertanyaan yang serupa dan agak sembrono.****
>
> Bagaimana cara memfilter kolom, kalau selama ini yang saya tahu masih
> filter baris..??****
>
> ** **
>
> *From:* Prazt Math [mailto:[email protected]]
> *Sent:* 19 September 2012 12:40
> *To:* [email protected]
> *Subject:* filter baris****
>
> ** **
>
> Dear para suhu excell, ane mau minta bantuan pada para exceller tapi mohon
> maaf apabila sudah ada pertanyaan yang serupa dan agak sembrono.****
>
> Bagaimana cara memfilter baris, kalau selama ini yang saya tahu masih
> filter kolom..??****
>
>
>
>
re-filter kolom.xlsb
Description: Binary data
