macro otomatik şireleme yapıyor

[önder34]

arkdaşlar siteden yaralanarak kullandığım macro sayfayı ototatik şifreleme ve süzme işemi yapıyor oysa ben bulmuş olduğu satırı sarı renk yapsın istiyorum dosyam ektedir bakabirmisiniz kullanmış olduğum macro ise şu :
Private Sub TextBox1_Change()
On Error Resume Next
NO = TextBox1.Value
Set FC2 = Range("A2:W65000").Find(What:=NO)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter Field:=3, Criteria1:=TextBox1.Value
If NO = "" Then
Selection.AutoFilter Field:=3
End If

End Sub
textbox a okul no girince bulunan satırı renki yapın istiyorum yada textbox a isim yzarak naıl buldurabiliriz
macronun orjinali ise şu şekilde :
Private Sub TextBox1_Change()
On Error Resume Next
ActiveSheet.Unprotect "aslan"
NO = TextBox1.Value
Set FC2 = Range("A8:R65000").Find(What:=NO)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter Field:=3, Criteria1:=TextBox1.Value
If NO = "" Then
Selection.AutoFilter Field:=3
End If
ActiveSheet.Protect "aslan"
End Sub

 

[Orion1]

Dosyanız ektedir.

Private Sub TextBox1_Change()
Dim NO As Double, sat As Long, adr As String, k As Range
   On Error Resume Next
        If IsNumeric(NO) Then
            NO = CDbl(TextBox1.Value)
            Else
            NO = 0
        End If
    Range("A1").AutoFilter
    sat = Cells(65536, "A").End(xlUp).Row
    Range("A2:W65536").Interior.ColorIndex = xlNone
    Range("A2:W65536").Font.ColorIndex = 0
    Range("A2:W65536").Font.Bold = False
    Range("A2:W65536").Font.Italic = False
    Set FC2 = Range("A2:A" & sat).Find(What:=NO)
    If Not FC2 Is Nothing Then
        adr = FC2.Address
        Do
            Range("A" & FC2.Row & ":W" & FC2.Row).Interior.Color = vbYellow
            Range("A" & FC2.Row & ":W" & FC2.Row).Font.Color = vbRed
            Range("A" & FC2.Row & ":W" & FC2.Row).Font.Bold = True
            Range("A" & FC2.Row & ":W" & FC2.Row).Font.Italic = True
            Set FC2 = Range("A2:A" & sat).FindNext(FC2)
        Loop While Not FC2 Is Nothing And k.Address <> adr
    End If
    Application.GoTo Reference:=Range(FC2.Address), _
       Scroll:=False
    Range("A1").AutoFilter Field:=1, Criteria1:=NO
    If NO = 0 Then
    Range("A1").AutoFilter Field:=1
    End If
    
End Sub

 

[önder34]

teşekkür ederim

Sayın Evren Gizlen ;
Emeğinize sağlık çok teşekkür ederim harikasınız.Bunu farklı sayfada kullanabilirmiyim ve yanına aynı yöntemle ad soyad yazarak da yapabilirmiyiz ?

 

[Orion1]

Sayın Evren Gizlen ;
Emeğinize sağlık çok teşekkür ederim harikasınız.Bunu farklı sayfada kullanabilirmiyim ve yanına aynı yöntemle ad soyad yazarak da yapabilirmiyiz ?

İstediğiniz şekilde kullanabilirsiniz..

 

[önder34]

neden veri süz yapıyor

Sayın Evren Gizlen ;
göndermiş olduğunuz dosyadaki makroyu kendi çalışmama uyarladım ama yine veri bütün sütunlara veri süz yapıyor ve 10 satırı renklendirdi bir sefer . yeni aramalarda satır renklendrime yapmıyor .İşin içinden iyice çıkamadım . yarımcı olabirseniz dosyamı ekte gönderiyorum