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

 

waduh...
itu makronya nguawur sekali...
belum dicoba sudah dikirim.., maaf..

seharusnya begini

Sub Mark_South1()
   Dim c As Range
   Range("D10:D300").ClearFormats
  
   For Each c In Range("D10:D300").Cells
      If Left(c.Value, 3) = "TN-" Then
      Select Case Mid(c.Value, 4, 1)
         Case "A", "B", "D", "E", "F", "G", "H", "J", "R", "S", "T", "X"
             With c
               .Interior.Color = RGB(0, 0, 255)
               .Font.Color = RGB(255, 255, 255)
               .Font.Bold = True
             End With
         End Select
      End If
   Next c
End Sub

atau begini:

Sub Mark_South2()
   Dim c As Range, k4 As String
   Range("D10:D300").ClearFormats
  
   For Each c In Range("D10:D300").Cells
      If Left(c.Value, 3) = "TN-" Then
         k4 = Mid(c.Value, 4, 1)
         If InStr(1, "ABDEFGHJRSTX", k4) > 0 Then
             With c
               .Interior.Color = RGB(0, 0, 255)
               .Font.Color = RGB(255, 255, 255)
               .Font.Bold = True
             End With
         End If
      End If
   Next c
End Sub

2009/8/31 siti Vi <setiyowati.devi@gmail.com>

Dear mang ujank,

berhubung semua formatting (Font Bolding, Kolor Font, Kolor Interior) ternyata SAMA
maka perintah memformat cukup ditulis sekali.

berhubung (lagi) kriteria untuk 4 huruf pertama pada tiap cell, dari "TN-A"  sampai "TN-Z" 
dapat pula dijaring dengan kriteria : 3 huruf pertama = "TN-"
maka tidak perlu lagi ada pemilihan BANYAK CASE, cukup SATU logical test dalam IF saja

Mungkin jadinya seperti ini :

Sub Mark_South()
  Dim c As Range

  For Each c In Range("D10:D300").Cells

    If Left(c.Value, 3) = "TN-" Then

      With c
        .Interior.Color = RGB(0, 0, 255)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
      End With

    End If
  Next c
End Sub




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 (5) 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              |
+-------------------------------------------------------------------+

Change settings via the Web (Yahoo! ID required)
Change settings via email: Switch delivery to Daily Digest | Switch format to Traditional
Visit Your Group | Yahoo! Groups Terms of Use | Unsubscribe

Recent Activity

•  84
  New Members
•  1
  New Files

Visit Your Group

Give Back

Yahoo! for Good

Get inspired

by a good cause.

Y! Toolbar

Get it Free!

easy 1-click access

to your groups.

Yahoo! Groups

Start a group

in 3 easy steps.

Connect with others.

.

__,_._,___