Soru Koşullu Biçimlendirme Makro

[leonadies]

Merhaba Üstadlar;
K5;BA1000 aralığındaki hücrelere 1,2,3....10 a kadar sayılar giriyorum.

Bu aralığa girdiğim hersayıda 1 yazan hücreler yeşil, 2 yazanlar kırmızı , 3 yazanlar ..... şeklinde değişik renkler yapmam gerekiyor.

K5;BA1000 aralığında bu hücrelere bu kuralı makro ile yapabilirmiyiz?
Not: bu aralıkta sayılar değişebiliyor. Dolayısıyla her seferinde ilk dolgu yok makrosu daha sonra bu kural çalışmalı.

Koşullu biçilendirme yapmak istemiyorum. Makro ile lazım. Teşekkürler

 

[Ömer]

Merhaba,

Deneyiniz. Kodların içindeki şartlar ve renk kodlarını kendinize göre düzenlersiniz.

Sub test()
   
    Dim alan As Range, d(), r(), hcr As Range, i As Byte
   
    Set alan = Range("K5:BA1000")
   
    alan.Interior.ColorIndex = xlNone
   
    d = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) 'şartlar
    r = Array(4, 3, 5, 8, 14, 16, 20, 19, 24, 56) 'renk kodları
   
    For Each hcr In alan
        If hcr <> "" Then
            For i = 0 To UBound(d)
                If d(i) = hcr Then
                    hcr.Interior.ColorIndex = r(i)
                    Exit For
                End If
            Next i
        End If
    Next hcr
   
End Sub

Renk kodlarının tablosunu linkten görebilirsiniz.

VBA Course: Colors

How to modify the colors of cells (background, text and borders), choose a color, modify the color of a tab...

www.excel-pratique.com

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodu sayfanın kod kısmına kopyalayın.
Ben 4'e kadar yaptım siz istediğiniz rakama kadar çoğaltabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("K5;BA100")) Is Nothing Then
        Select Case Target
        Case 1
            Target.Interior.ColorIndex = 3
        Case 2
            Target.Interior.ColorIndex = 46
        Case 3
            Target.Interior.ColorIndex = 5
        Case 4
            Target.Interior.ColorIndex = 8
           
        End Select
    End If
End Sub

Renk kodları aşağıdaki gibidir.

 

[leonadies]

Merhaba,

Deneyiniz. Kodların içindeki şartlar ve renk kodlarını kendinize göre düzenlersiniz.

Sub test()
 
    Dim alan As Range, d(), r(), hcr As Range, i As Byte
 
    Set alan = Range("K5:BA1000")
 
    alan.Interior.ColorIndex = xlNone
 
    d = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) 'şartlar
    r = Array(4, 3, 5, 8, 14, 16, 20, 19, 24, 56) 'renk kodları
 
    For Each hcr In alan
        If hcr <> "" Then
            For i = 0 To UBound(d)
                If d(i) = hcr Then
                    hcr.Interior.ColorIndex = r(i)
                    Exit For
                End If
            Next i
        End If
    Next hcr
 
End Sub

Renk kodlarının tablosunu linkten görebilirsiniz.

VBA Course: Colors

How to modify the colors of cells (background, text and borders), choose a color, modify the color of a tab...

www.excel-pratique.com

Üstadım ellerinize sağlık

 

[leonadies]

Merhaba.

Aşağıdaki kodu sayfanın kod kısmına kopyalayın.
Ben 4'e kadar yaptım siz istediğiniz akama kadar çoğaltabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("K5;BA100")) Is Nothing Then
        Select Case Target
        Case 1
            Target.Interior.ColorIndex = 3
        Case 2
            Target.Interior.ColorIndex = 46
        Case 3
            Target.Interior.ColorIndex = 5
        Case 4
            Target.Interior.ColorIndex = 8
          
        End Select
    End If
End Sub

Renk kodları aşağıdaki gibidir.

Ekli dosyayı görüntüle 232629

Ellerinize sağlık buda çok güzel Başka arkdşlarada faydalı olması dileğiyle