Kemarin ada lagi permintaan untuk melakukan autofilter kolom berdasarkan warna cell.
langsung saja aku jawab dengan hati yang girang, karena bisa berbagi lagi...."ocreh tunggu bentar ya"
Dalam postingan ini aku akan membahas mengenai cara melakukan filter data excel berdasarkan warna cell dalam satu kolom.
Permasalahan dalam file tersebut pada range B5 s/d B14 akan di filter cuman filternya berdasarkan warna dari tiap cel yang ada di range tersebut.
Nach... untuk melakukan filter tersebut dibuatlah bantuan pada akhir kolom, untuk menentukan index warna dari tiap-tiap cel yang ada di range B5 s/d B14, berikut kodenya :
Seperti biasa, untuk file-nya bisa langsung di DOWNLOAD disini
langsung saja aku jawab dengan hati yang girang, karena bisa berbagi lagi...."ocreh tunggu bentar ya"
Dalam postingan ini aku akan membahas mengenai cara melakukan filter data excel berdasarkan warna cell dalam satu kolom.
Permasalahan dalam file tersebut pada range B5 s/d B14 akan di filter cuman filternya berdasarkan warna dari tiap cel yang ada di range tersebut.
Nach... untuk melakukan filter tersebut dibuatlah bantuan pada akhir kolom, untuk menentukan index warna dari tiap-tiap cel yang ada di range B5 s/d B14, berikut kodenya :
Sub filter_warna() Dim lg As Long Application.ScreenUpdating = False lg = Range("D2").Interior.ColorIndex 'lg sebagai nilai warna di cel D2 Range("E5:E14").Font.ColorIndex = 2 'huruf di range E5 s/d E14 menjadi putih 'mengkondisikan nilai di cell E5 s/d E14 menjadi nilai dari warna di cell For i = 5 To 14 Cells(i, 5).Value = Cells(i, 2).Interior.ColorIndex Next With Sheet1.Rows("4:65536") .AutoFilter .AutoFilter Field:=5, Criteria1:=lg End With Application.ScreenUpdating = True End Sub Sub buka_filter() Application.ScreenUpdating = False If Sheet1.AutoFilterMode Then Sheet1.Cells.AutoFilter Sheet1.Range("E5:E14").Clear End If Application.ScreenUpdating = True End Sub
Seperti biasa, untuk file-nya bisa langsung di DOWNLOAD disini
6 comments:
Wanna link exchange?
http://ifanqomarudin.blogspot.com/2010/05/artisteer.html
berikut ini kode macro tanpa harus memperhatikan jumlah baris dan kolom range yang ada :
Option Explicit
Dim rc As Long
Dim kc As Long
Sub filter_warna()
Dim lg As Long
Dim i As Long
Application.ScreenUpdating = False
lg = Range("D2").Interior.ColorIndex 'lg sebagai nilai warna di cel D2
rc = ActiveSheet.UsedRange.Rows.Count 'menghitung range baris paling akhir
kc = ActiveSheet.UsedRange.Columns.Count + 1 'menghitung kolom paling akhir yang kosong
'mengkondisikan nilai di cell E5 s/d E14 menjadi nilai dari warna di cell
For i = kc To rc
Cells(i, kc).Value = Cells(i, 2).Interior.ColorIndex
Cells(i, kc).Font.ColorIndex = 2
Next
With Sheet1.Rows("4:65536")
.AutoFilter
.AutoFilter Field:=kc, Criteria1:=lg
End With
Application.ScreenUpdating = True
End Sub
Sub buka_filter()
rc = ActiveSheet.UsedRange.Rows.Count 'menghitung range baris paling akhir
kc = ActiveSheet.UsedRange.Columns.Count + 1 'menghitung kolom paling akhir yang kosong
Application.ScreenUpdating = False
If Sheet1.AutoFilterMode Then
Sheet1.Cells.AutoFilter
Sheet1.Cells(rc, kc).Clear
End If
Application.ScreenUpdating = True
End Sub
pada kode buka filter()
cari kode :
Sheet1.Cells(rc, kc).Clear
kemudian ganti dengan kode
Sheet1.Range(Cells(kc, kc), Cells(rc, kc)).Clear
Posting Komentar