Color Index

[tursay]

Merhabalar,

Makro kodları ile A kolonundaki hucrelerde bulunan renklere ait index numaralarını B kolonuna nasıl yazdıranilirim?

Teşekkurler.

 

[Orion1]

A1:A10 aralığnda hücrelerin arka plan renk kodlarını b sütununa yazar.

Sub renk_indexleri()
For i = 1 To 10
    Range("B" & i).Value = Range("A" & i).Interior.ColorIndex
Next
End Sub

 

[usta07]

KOD SAYFASI İÇİN ALT+F11 TUŞLARINA BİRLİKTE BASIN.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo ws_exit:
Set rng = Application.Intersect(Target, Me.Range("a:a"))

'("a:a")) sütununu belirtir. Bunu değiştirirerek istenilen alana uygulayabiliriz.

If rng Is Nothing Then Exit Sub
With Target
Select Case LCase(.Value)

'Select Case LCase(.Value) küçük harfe duyarlı.
'Select Case UCase(.Value) büyük harfe duyarlı.

'Burada "" içindeki rakamlar yerine sözcükler yazılabilir.
' = İşaretinden sonra yer alan sayılar renk indeksidir.

'.Interior.ColorIndex yerine .Font.ColorIndex kullanılark biçimlendirmeyi fonta göre yapmak mümkün.

Case Is = "1": .Interior.ColorIndex = 1
Case Is = "2": .Interior.ColorIndex = 2
Case Is = "3": .Interior.ColorIndex = 3
Case Is = "4": .Interior.ColorIndex = 4
Case Is = "5": .Interior.ColorIndex = 5
Case Is = "6": .Interior.ColorIndex = 6
Case Is = "7": .Interior.ColorIndex = 7
Case Is = "8": .Interior.ColorIndex = 6
Case Is = "9": .Interior.ColorIndex = 9
Case Is = "10": .Interior.ColorIndex = 10
Case Is = "11": .Interior.ColorIndex = 11
Case Is = "12": .Interior.ColorIndex = 12
Case Is = "13": .Interior.ColorIndex = 13
Case Is = "14": .Interior.ColorIndex = 14
Case Is = "15": .Interior.ColorIndex = 15
Case Is = "16": .Interior.ColorIndex = 16
Case Is = "17": .Interior.ColorIndex = 17
Case Is = "18": .Interior.ColorIndex = 18
Case Is = "19": .Interior.ColorIndex = 19
Case Is = "20": .Interior.ColorIndex = 20
Case Is = "21": .Interior.ColorIndex = 21
Case Is = "22": .Interior.ColorIndex = 22
Case Is = "23": .Interior.ColorIndex = 23
Case Is = "24": .Interior.ColorIndex = 24
Case Is = "25": .Interior.ColorIndex = 25
Case Is = "26": .Interior.ColorIndex = 26
Case Is = "27": .Interior.ColorIndex = 27
Case Is = "28": .Interior.ColorIndex = 28
Case Is = "29": .Interior.ColorIndex = 29
Case Is = "30": .Interior.ColorIndex = 30
Case Is = "31": .Interior.ColorIndex = 31
Case Is = "32": .Interior.ColorIndex = 32
Case Is = "33": .Interior.ColorIndex = 33
Case Is = "34": .Interior.ColorIndex = 34
Case Is = "35": .Interior.ColorIndex = 35
Case Is = "36": .Interior.ColorIndex = 36
Case Is = "37": .Interior.ColorIndex = 37
Case Is = "38": .Interior.ColorIndex = 38
Case Is = "39": .Interior.ColorIndex = 39
Case Is = "40": .Interior.ColorIndex = 40
Case Is = "41": .Interior.ColorIndex = 41
Case Is = "42": .Interior.ColorIndex = 42
Case Is = "43": .Interior.ColorIndex = 43
Case Is = "44": .Interior.ColorIndex = 44
Case Is = "45": .Interior.ColorIndex = 45
Case Is = "46": .Interior.ColorIndex = 46
Case Is = "47": .Interior.ColorIndex = 47
Case Is = "48": .Interior.ColorIndex = 48
Case Is = "49": .Interior.ColorIndex = 49
Case Is = "50": .Interior.ColorIndex = 50
Case Is = "51": .Interior.ColorIndex = 51
Case Is = "52": .Interior.ColorIndex = 52
Case Is = "53": .Interior.ColorIndex = 53
Case Is = "54": .Interior.ColorIndex = 54
Case Is = "55": .Interior.ColorIndex = 55
Case Is = "56": .Interior.ColorIndex = 56

Case Else
.Interior.ColorIndex = xlNone
End Select
End With

ws_exit:
End Sub

 

[Orion1]

Sayın usta07 ,size 2nci mesajda yazdığım kodları incelemenizi tavsiye ederim.

 

[halit3]

Merhabalar,

Makro kodları ile A kolonundaki hucrelerde bulunan renklere ait index numaralarını B kolonuna nasıl yazdıranilirim?

Teşekkurler.

alternatif kod A1 den A20 kadar olan satırdaki renkleri B sutünuna yazar

Sub renkleriyaz()
For j = 1 To 20
For i = 1 To 56
If Cells(j, 1).Interior.ColorIndex <> xlNone Then
If Cells(j, 1).Interior.ColorIndex = i Then
Cells(j, 2).Value = i
i = 56
End If
End If
Next
Next
End Sub

 

[tursay]

A1:A10 aralığnda hücrelerin arka plan renk kodlarını b sütununa yazar.

Sub renk_indexleri()
For i = 1 To 10
    Range("B" & i).Value = Range("A" & i).Interior.ColorIndex
Next
End Sub

Cevap veren tüm arkadaslara ilgilerinden dolayı teşekkur ederim. Ancak sayın Evren Gizlen in yazmış olduğu kod istediğim koddur.

Herkese kolay gelsin.
İyi çalışmalar...