duplicate value makrosu hk

[u.L.a.s]

merhabalar

aşağıdaki kod düzeneğinde E sütununda tekrarlayan veri olunca tekrarlayan veri rengini kırmızı renk yapıyor.

Ben bu durumu sadece E sütununda değil aynı anda K sütununda da yapsın istiyorum bu kod düzeneğinde nasıl bir değişiklik yapılması gerekir bilgi ve yardımlarınızı rica ederim

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 1 Then Exit Sub            
   
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
   
    Dim myDataRng As Range
    Dim cell As Range
   

    Set myDataRng = Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row)
   
    For Each cell In myDataRng
        cell.Offset(0, 0).Font.Color = vbBlack        
   
     
        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed      
        End If
    Next cell
   
    Set myDataRng = Nothing
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   
    End sub

 

[hamitcan]

Bu şekilde deneyin.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row = 1 Then Exit Sub
   
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
   
    Dim myDataRng As Range
    Dim myDataRng2 As Range
    Dim cell As Range
   

    Set myDataRng = Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    Set myDataRng2 = Range("k2:k" & Cells(Rows.Count, "k").End(xlUp).Row)
    For Each cell In myDataRng
        cell.Offset(0, 0).Font.Color = vbBlack
   
     
        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed
        End If
    Next cell
     For Each cell In myDataRng2
        cell.Offset(0, 0).Font.Color = vbBlack
   
     
        If Application.Evaluate("COUNTIF(" & myDataRng2.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed
        End If
    Next cell
   
    Set myDataRng = Nothing
    Set myDataRng2 = Nothing
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   
    End Sub

 

[u.L.a.s]

çok teşekkürler üstadım emeğine bilgine sağlık