zetkatamet
Altın Üye
- Katılım
- 13 Mart 2008
- Mesajlar
- 1,408
- Excel Vers. ve Dili
- Office 365 Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub KOD()
Dim Alan As Range
Dim a
Dim s, i, b, c, d
a = InputBox("metin giriniz", "metin")
s = ActiveSheet.Name
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
Sheets(i).Select
For Each Alan In ActiveSheet.UsedRange
If Alan.Value Like "*" & a & "*" Then
b = Alan.Value
c = VBA.InStr(1, b, a)
d = Len(a)
Alan.Characters(c, d).Font.Color = vbBlue
End If
Next Alan
Next i
Sheets(s).Select
Application.ScreenUpdating = True
MsgBox "B i t t i "
End Sub
Sub Celltest2()
Dim rw As Range, cel As Range
Dim i As Integer
Dim char
For Each rw In Range("A1:A250").Rows ' Bakılan satır\hücreler
For Each cel In rw.Cells
For i = 1 To Len(cel)
If cel.Characters(i, 3).Text Like "*geç*" Then 'kaç karakter arıyorsanız ona göre düzenleyin.
cel.Characters(i, 3).Font.ColorIndex = 3
Exit For
End If
Next i
Next
Next
End Sub