Soru Makro açıklaması ?

[UysalMuzaffer]

Merhaba, elimde bir excel dosyası var üzerinde çalışıp daha sade ve iyi bir şey yapmak istiyorum.
O yüzden size takıldığım bazı yerlerde yardım isteyeceğim.. Öncelikle; Burada ne anlatmak istiyor ?

Sub mukerrer()
For a = 1 To [a65536].End(xlUp).row
If WorksheetFunction.CountIf(Columns(1), Cells(a, 1)) > 1 Then Cells(a, 1).Interior.ColorIndex = 5
Next
End Sub

 

[çıtır]

1.Sütunda tekrar eden verileri renkli gösterir.

 

[UysalMuzaffer]

Var olan exceli kendim yeni dizayn ediyorum da,

=ColorIndex(A4)
diye formül var arka planın rengine göre kodunu veriyor, fakat yeni excel'de #AD? hatası veriyor sebebi nedir ?

 

[çıtır]

Üstteki örnek formül değil makro kodu.Burda makro çalıştırıldığında 1.Sütunda 1den fazla tekrarlayan değerlerde dolgu renklenir.Sizin yazdığın formülse olmaz.Hata vermesi normal.

 

[UysalMuzaffer]

Üstteki örnek formül değil makro kodu.Burda makro çalıştırıldığında 1.Sütunda 1den fazla tekrarlayan değerlerde dolgu renklenir.Sizin yazdığın formülse olmaz.Hata vermesi normal.

Cevaplarınız ve açıklayıcı yorumlarınız için teşekkür ediyorum,
Örnek aldığım excel dosyasında olmuş fakat, ben burada bu formülü (ColorIndex) nasıl kullnabilirim peki ?

 

[çıtır]

Cells(a, 1).Interior.ColorIndex = 5
Yukardaki makroda 5 sayısını 1 den 56 kadar değiştirerek değişik renkler verebilirsiniz.Sizin yapmak istediğinizin ne olduğunu tam olarak anlamadım.Anladığım kadar umarım cevabım işinizi görür.

 

[UysalMuzaffer]

Orayı geçtim ben, renkleri internetten bulup 42 olarak değiştirip güzel bir renk elde ettim.
J sütunundaki formüller =ColorIndex(A4) diye aşağı doğru gidiyor. Yani A sutünün arka plandaki renk kodunu oraya yazıyor sanırım.
Yani J4'e 42 yazması gerekiyor. Anlatabildim mi acaba ?

 

[çıtır]

Formülle renk kodunu öğrenemezsiniz.Kullanıcı tanımlı fonksiyon(makro) veya makro ile J sütuna yazdırabilirsiniz.

 

[UysalMuzaffer]

Ben buradaki J sütununu formülü kendi excelime taşımak istiyorum o zaman yardımcı olabilir misiniz bu konuda ?
Yada başka bir formül, makro vs yol..

 

[çıtır]

Burda kullanıcı tanımlı fonksiyon kullanılmış.Bu dosyadan alıp sizde kullanabilirsiniz.

 

[UysalMuzaffer]

Function ColorIndex(rng As Range, Optional text As Boolean = False) As Variant
Dim cell As Range, row As Range
Dim i As Long, j As Long
Dim iWhite As Long, iBlack As Long
Dim aryColours As Variant

If rng.Areas.Count > 1 Then
ColorIndex = CVErr(xlErrValue)
Exit Function
End If

iWhite = WhiteColorindex(rng.Worksheet.Parent)
iBlack = BlackColorindex(rng.Worksheet.Parent)

If rng.Cells.Count = 1 Then
If text Then
aryColours = DecodeColorIndex(rng, True, iBlack)
Else
aryColours = DecodeColorIndex(rng, False, iWhite)
End If

Else
aryColours = rng.Value
i = 0

For Each row In rng.Rows
i = i + 1
j = 0

For Each cell In row.Cells
j = j + 1

If text Then
aryColours(i, j) = _
DecodeColorIndex(cell, True, iBlack)
Else
aryColours(i, j) = _
DecodeColorIndex(cell, False, iWhite)
End If

Next cell

Next row

End If

ColorIndex = aryColours

End Function

Sanırım bu kod ama yapıştırıp çalıştır deyince ilk satırın arka planı sarı oluyor, hata veriyor galiba pek makro ile alakam yok

 

[çıtır]

Deneyiniz.

Sub renkyaz()
Dim i As Integer
For i = 4 To [a65536].End(xlUp).Row
If Range("A" & i) <> "" Then: Range("J" & i) = Range("A" & i).Interior.ColorIndex
Next i
End Sub

 

[UysalMuzaffer]

Deneyiniz.

Sub renkyaz()
Dim i As Integer
For i = 4 To [a65536].End(xlUp).Row
If Range("A" & i) <> "" Then: Range("J" & i) = Range("A" & i).Interior.ColorIndex
Next i
End Sub

Olmadı.. Oradaki tüm modelleri alıp kalabalık yapmak istemiyorum çoğunu kullanmıyoruz.. ColorIndex yeterli gibi şuanlık sadece..

 

[UysalMuzaffer]

Attribute VB_Name = "Module5"
Function ColorIndexOfCell(rng As Range, _
Optional OfText As Boolean, _
Optional DefaultAsIndex As Boolean = True) As Integer
Dim c As Long
If OfText = True Then
c = rng.Font.ColorIndex
Else
c = rng.Interior.ColorIndex
End If
If (c < 0) And (DefaultAsIndex = True) Then
If OfText = True Then
c = GetBlack(rng.Worksheet.Parent)
Else
c = GetWhite(rng.Worksheet.Parent)
End If
End If
ColorIndexOfCell = c
End Function
Function GetWhite(WB As Workbook) As Long
Dim Ndx As Long
For Ndx = 1 To 56
If WB.Colors(Ndx) = &HFFFFFF Then
GetWhite = Ndx
Exit Function
End If
Next Ndx
GetWhite = 0
End Function
Function GetBlack(WB As Workbook) As Long
Dim Ndx As Long
For Ndx = 1 To 56
If WB.Colors(Ndx) = 0& Then
GetBlack = Ndx
Exit Function
End If
Next Ndx
GetBlack = 0
End Function

Bu modül ile =ColorIndexOfCell ile kullanılabilir. Sorunu çözdüm, teşekkür ederim