FILTER WARNA CELL DI EXCEL


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 :

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 komentar:

  1. Visiting here with smile. Nice greetings from Jakarta & don't forget to visit me back...
    Wanna link exchange?
    http://ifanqomarudin.blogspot.com/2010/05/artisteer.html

    BalasHapus
  2. Mas koq filternya cuman beberapa baris saja yang bisa ya ?

    BalasHapus
  3. coba perhatikan keterangan kode yang berwarna hijau diatas, kode For i = 5 To 14, sebagai kondisi dari nilai cell yang akan di filter berdasarkan nilai warna cell.
    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

    BalasHapus
  4. sory ada kesalahan he...he... maklum udah tua....
    pada kode buka filter()
    cari kode :
    Sheet1.Cells(rc, kc).Clear

    kemudian ganti dengan kode
    Sheet1.Range(Cells(kc, kc), Cells(rc, kc)).Clear

    BalasHapus
  5. maaf semuanya...yang jd pertanyaan saya...itu scrift di taro dimana??emang ms.excel ada form buat naro scrift seperti tu ya???

    BalasHapus
  6. Sebelumnya terima kasih telah bertandang... hasil kode vb macro bisa dilihat di Tools - Macro - Visual Basic Editor...

    BalasHapus