Makro yardım

[hüseyintok]

Merhaba Makro "C" sutununda "x" varsa "j" stunundaki ismi kırmızıya boyuyor. fakat ikinci adımda "j" stununda kırmızı ile boyalı ismi, "j" de aynı isme sahip ("x" koşuluna sahip olmayan) boyasız isimleri bulup yeşil yapmasını istiyorum. şuan sadece "x" koşulu olanlar yeşil oluyor.
yardımcı olurmusunuz

Sub Isim()
Dim ws As Worksheet
Dim rngC As Range, rngJ As Range, cell As Range

Set ws = ThisWorkbook.Worksheets("Sheet1") '

Set rngC = ws.Range("C7:C600")
Set rngJ = ws.Range("J7:J600")

For Each cell In rngC
If cell.Value = "x" Then
cell.Offset(0, 7).Font.Color = RGB(255, 0, 0) ' Kirmizi ile isaretle
End If
Next cell

For Each cell In rngJ
If cell.Font.Color = RGB(255, 0, 0) And WorksheetFunction.CountIf(rngJ, cell.Value) > 1 Then
cell.Font.Color = RGB(0, 255, 0) ' Yesil ile isaretle
End If
Next cell
End Sub

 

[hüseyintok]

Arkadaşlar konu günceldir.

 

[yanginci34]

Denermisiniz.

Sub Isim()
Dim ws As Worksheet
Dim rngC As Range, rngJ As Range, cell As Range

Set ws = ThisWorkbook.Worksheets("Sheet1") '

Set rngC = ws.Range("C3:C600")
Set rngJ = ws.Range("J3:J600")

For Each cell In rngC
If cell.Value = "x" Then
cell.Offset(0, 7).Font.Color = RGB(255, 0, 0) ' Kirmizi ile isaretle
End If
Next cell

For Each cell In rngJ
If cell.Offset(0, -7) <> "x" And WorksheetFunction.CountIf(rngJ, cell.Value) > 1 Then
cell.Font.Color = -11489280 ' Yesil ile isaretle
End If
Next cell
End Sub

 

[muygun]

Merhaba;
Alternatif:
Doğru anladıysam eki deneyin.
İyi çalışmalar.

 

[hüseyintok]

Çok teşekkür ederim iki yöntemde çok başarılı.

 

[yanginci34]

Rica ederim kolay gelsin.