Aynı isimdeki Hücreleri Renklendirme.

[ismail-34]

Çok Değerli Excel Web Ailesine selamlar.

Benim sorum mevcut bir çalışmama renklendirme işlemi koymak.

Sayfa 1 de b3 satırından başlayan firma isimlerinden renkli olanları, sayfa 2 deki b5 ten başlayan firma isimleriyle aynı olanları bulup bir makro butonu vasıtasıyla aynı şekilde renklendirsin istiyorum.

Herkese saygılar sevgiler.

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[yanginci34]

Aleyküm selam denermisiniz.

 

[Korhan Ayhan]

Find (CTRL+F) metodu daha hızlı sonuç verecektir..

Option Explicit

Sub Color_Match_Data()
    Dim S1 As Worksheet, S2 As Worksheet, Rng As Range, Find_Data As Range
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    For Each Rng In S2.Range("B5:B" & S2.Cells(S2.Rows.Count, 2).End(3).Row)
        Set Find_Data = S1.Range("B:B").Find(Rng.Value, LookAt:=xlWhole)
        If Not Find_Data Is Nothing Then
            Rng.Interior.Color = Find_Data.Interior.Color
        End If
    Next
    
    Set Find_Data = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Renklendirme işlemi tamamlanmıştır.", vbInformation
End Sub

 

[ismail-34]

Merhaba;
Eki deneyin.
İyi çalışmalar.

Teşekkür Ederim değerli muygun hocam çok Uygun

 

[ismail-34]

Find (CTRL+F) metodu daha hızlı sonuç verecektir..

Option Explicit

Sub Color_Match_Data()
    Dim S1 As Worksheet, S2 As Worksheet, Rng As Range, Find_Data As Range
   
    Application.ScreenUpdating = False
   
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
   
    For Each Rng In S2.Range("B5:B" & S2.Cells(S2.Rows.Count, 2).End(3).Row)
        Set Find_Data = S1.Range("B:B").Find(Rng.Value, LookAt:=xlWhole)
        If Not Find_Data Is Nothing Then
            Rng.Interior.Color = Find_Data.Interior.Color
        End If
    Next
   
    Set Find_Data = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox "Renklendirme işlemi tamamlanmıştır.", vbInformation
End Sub

Teşekkürler Çok değerli Korhan hocam buda güzel çalışıyor elinize sağlık.

 

[ismail-34]

Aleyküm selam denermisiniz.

Aynen bu çözümde saat gibi çalışıyor sağolun.