Hot Fox: Re: ]] XL-mania [[ sederhanakan select case

domingo, 30 de agosto de 2009

Re: ]] XL-mania [[ sederhanakan select case

Dear Pak Sandy Warsito,

pada sebuah sheet baru, buat sebuah kolom berisi semua case. Misal sheet itu bernama kondisi, kemudian buat sebuah named range untuk kolom itu misal nama range-nya adalah kasus.

Lalu pada sheet kerja yang di for each next di vba itu (tapi pada real worksheet bukan dibaris programnya), blok range D10, lalu buat conditional formatting pilih yang use formula. Tulis formula :
=IsNumber(Match(Left(D10,4), kasus, 0))

kemudian atur formatnya pada font pilih Bold dan pada fill pilih warnanya atau yang lainnya sesuai keinginan.
Lalu tekn ok. Ubah range yang akan diberi conditional formatting ini untuk D10:D300, lalu tekan apply atau Ok.

Setelah itu, kode vba bagian ini bisa diisi dengan hal lain karena tidak diperlukan lagi.

Tapi, kalau masih ngebet ingin pakai vba, setelah buat

Sub Mark_South()

    dim c as range

    For Each c In Range("D10:D300")
      With c
          If Evaluate("isnumber(match(" & .value & ",kasus,0))") Then
                   .Interior.Color = RGB(0, 0, 255)
                   .Font.Color = RGB(255, 255, 255)
                   .Font.Bold = True
          End If
        End With
    Next c
End Sub

Jika ada penambahan atau pengurangan case baru, lakukan di sheet kondisi tadi, lalu ubah referansi named range kasus. Bisa juga jika named range kasus dibuat dinamis dengan formula offset() yang berisi counta(). Jika kuatir bila mode kalkulasi excel dibuat manual oleh user, mungkin perlu penambahan baris kode setelah with c dengan range("kasus").calculate

Kid.

2009/8/29 Sandy Warsito <mank_ujank@yahoo.com>

Dear Suhu-suhu Excel yang budiman,

Saya telah menulis code seperti di bawah dan sudah bekerja dengan baik, namun dengan listing seperti ini sepertinya akan kesulitan jika suatu saat nanti perlu mengedit case-case nya. Please help untuk menyederhanakannya sehingga mengedit case akan lebih mudah.

Makasih.

'======================================================

Sub Mark_South()

For Each c In Range("D10:D300").Cells
Select Case Left(c.Value, 4)
Case "TN-A"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-B"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-D"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-E"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-F"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
End With
Case "TN-G"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-H"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-J"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-R"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-S"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-T"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With
Case "TN-T"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With

Case "TN-X"
    With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
    End With

End Select
Next c
End Sub

'======================================================

__._,_.___

Messages in this topic (2) Reply (via web post) | Start a new topic

Messages

+-:: XL-mania ::::::::::::::::::::----------------------------------+
| Selamat menjalankan ibadah puasa...                               |
| http://www.facebook.com/group.php?gid=37671048001&ref=mf          |
+-------------------------------------------------------------------+
| DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, |
| pembicaraan pribadi, one line message, melecehkan, tidak sopan. |
+-------------------------------------------------------------------+
| Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu" |
| Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu. |
+-------------------------------------------------------------------+
| Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke |
| XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari |
| http://groups.yahoo.com/group/XL-mania/files/Promotion/           |
+-------------------------------------------------------------------+
| Berikan testimoni di : http://www.friendster.com/xlmania atau... |
| http://www.xl-mania.com/2008/06/testimoni-xl-mania.html           |
+-------------------------------------------------------------------+
| Message lama ada di :                                             |
| http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id] |
| http://www.mail-archive.com/xl-mania@yahoogroups.com              |
+-------------------------------------------------------------------+

MARKETPLACE

Mom Power: Discover the community of moms doing more for their families, for the world and for each other