Kelime Değiştirme

[steppe]

Merhaba Arkadaşlar,
Forum sayfasından bulduğum kodların üzerinde epeyce çalıştım fakat değişen ve değiştirilen kelimeleri renklendiremedim.
Örnek dosyada hedef sayfasında A2 hücresindeki kriterlere ve bunun yerine konulan B2 hücresinde ölçütlere kelimesini kırmızı yapmak istiyorum.
Yardımlarınız için şimdiden teşekkür ederim.İyi akşamlar.

 

[YUSUF44]

Aşağıdaki kodu bir modüle kopyalayıp deneyin:

Sub renklendir()
On Error Resume Next
Set s1 = Sheets("kaynak")
Set s2 = Sheets("hedef")

son = s1.Cells(Rows.Count, "A").End(3).Row

For i = 2 To son
    başA = WorksheetFunction.Search(s1.Cells(i, "A"), s2.[A2])
    sonA = Len(s1.Cells(i, "A"))
    s2.[A2].Characters(Start:=başA, Length:=sonA).Font.Color = vbRed
Next
For j = 2 To son
    başB = WorksheetFunction.Search(s1.Cells(j, "B"), s2.[B2])
    sonB = Len(s1.Cells(j, "B"))
    s2.[B2].Characters(Start:=başB, Length:=sonB).Font.Color = vbRed
Next

End Sub

 

[steppe]

Yusuf Hocam,
İlgin için çok teşekkür ederim.
Yalnız kelime değiştirme yapmıyor.Kaynak sayfasındaki kelimelere göre hedef sayfasında

kriterlere yerine ölçütlere
tüm ürünler yerine bütün mallar
numune yerine örnek

kelimeleri gelecek ve de bu kelimeler hedef sayfasında A2'de ve B2'de kırmızı renkli olacaktı.

 

[YUSUF44]

Kelimelerin değiştirilmesini istememiştiniz, sadece renklendirme istemiştiniz.

Dosyanızda bulunan değişiklik makrosuyla verdiğim kodun birleşimi şu şekilde oluyor:

Sub renklendir()
On Error Resume Next
Set s1 = Sheets("kaynak")
Set s2 = Sheets("hedef")

son = s1.Cells(Rows.Count, "A").End(3).Row
s2.[A2:B2].Font.Color = vbBlack

For sat = 2 To son
    ara = Sheets("kaynak").Cells(sat, "A"): yaz = Sheets("kaynak").Cells(sat, "B")
    Sheets("hedef").Range(alan2).Replace What:=ara, Replacement:=yaz, LookAt:=xlPart
    
Next

For j = 2 To son
    başA = WorksheetFunction.Search(s1.Cells(j, "A"), s2.[A2])
    sonA = Len(s1.Cells(j, "A"))
    s2.[A2].Characters(Start:=başA, Length:=sonA).Font.Color = vbRed
Next
For k = 2 To son
    başB = WorksheetFunction.Search(s1.Cells(k, "B"), s2.[B2])
    sonB = Len(s1.Cells(k, "B"))
    s2.[B2].Characters(Start:=başB, Length:=sonB).Font.Color = vbRed
Next
End Sub

 

[steppe]

Yusuf Hocam,
Yardımın için çok teşekkür ederim.

Sub renklendir()
On Error Resume Next
Set s1 = Sheets("kaynak")
Set s2 = Sheets("hedef")

alan1 = "A2": alan2 = "B2" 'bu böümü ekleyince değiştirme yaptı
Sheets("hedef").Range(alan1).Copy 'bu böümü ekleyince değiştirme yaptı

son = s1.Cells(Rows.Count, "A").End(3).Row
s2.[A2:B2].Font.Color = vbBlack

For sat = 2 To son
ara = Sheets("kaynak").Cells(sat, "A"): yaz = Sheets("kaynak").Cells(sat, "B")
Sheets("hedef").Range(alan2).Replace What:=ara, Replacement:=yaz, LookAt:=xlPart

Next

For j = 2 To son
başA = WorksheetFunction.Search(s1.Cells(j, "A"), s2.[A2])
sonA = Len(s1.Cells(j, "A"))
s2.[A2].Characters(Start:=başA, Length:=sonA).Font.Color = vbRed
Next
For k = 2 To son
başB = WorksheetFunction.Search(s1.Cells(k, "B"), s2.[B2])
sonB = Len(s1.Cells(k, "B"))
s2.[B2].Characters(Start:=başB, Length:=sonB).Font.Color = vbRed
Next
End Sub