DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
[SIZE="2"]Sub Emre()
Dim [COLOR="Blue"]aranacak[/COLOR]$, [COLOR="DarkOrange"]baslangic[/COLOR]%
[COLOR="Blue"]aranacak[/COLOR] = "[COLOR="Red"]aranacak veriyi buraya yazın[/COLOR]"
[COLOR="DarkOrange"]baslangic [/COLOR]= InStr(1, Range("A1").Value, [COLOR="blue"]aranacak[/COLOR], 1)
Range("A1").Characters([COLOR="darkorange"]baslangic[/COLOR], Len([COLOR="blue"]aranacak[/COLOR])).Font.ColorIndex = 3
[COLOR="Blue"]aranacak [/COLOR]= vbNullString: [COLOR="DarkOrange"]baslangic [/COLOR]= Empty
End Sub[/SIZE]
Daha sonra isteğiniz değişmeyecekse yanıt vereyim.
[SIZE="2"]Sub Emre()
Dim [COLOR="Red"]aranacak[/COLOR]$, [COLOR="Blue"]baslangic[/COLOR]%, [COLOR="DarkOrange"]i[/COLOR]&
[COLOR="red"]aranacak [/COLOR]= "[COLOR="SeaGreen"]aranacak veriyi buraya yazın[/COLOR]"
For [COLOR="darkorange"]i [/COLOR]= 1 To Cells(Rows.Count, "[COLOR="Magenta"][B]A[/B][/COLOR]").End(3).Row
[COLOR="blue"]baslangic [/COLOR]= InStr(1, Range("[COLOR="Magenta"][B]A[/B][/COLOR]" & [COLOR="darkorange"]i[/COLOR]).Value, [COLOR="red"]aranacak[/COLOR], 1)
If [COLOR="Blue"]baslangic[/COLOR] > 0 Then Range("[B][COLOR="magenta"]A[/COLOR][/B]" & [COLOR="darkorange"]i[/COLOR]).Characters([COLOR="blue"]baslangic[/COLOR], Len([COLOR="red"]aranacak[/COLOR])).Font.ColorIndex = 3
Next [COLOR="darkorange"]i[/COLOR]
[COLOR="red"]aranacak [/COLOR]= vbNullString: [COLOR="blue"]baslangic[/COLOR] = Empty: [COLOR="darkorange"]i [/COLOR]= Empty
End Sub[/SIZE]