Textbox arama verilerinin yerini ayarlama

[rhymr]

Arkadaşlar elimde forumdan bulduğum bir arama dökümanı var fakat istediğim sütunlara göre ayarlayamadım. VBA kodlarına da baktım fakat 2 textbox dan bitanesi normal fakat textbox2 istediğim gibi değil textbox2 veri sayfasındaki b sütununa göre arıyor ben veri sayfasındaki e yani not yazan kısma göre arama yapmasını istiyorum. dosyayı ek'e ekledim. düzeltebilecek bi arkadaş varsa büyük sevaba girer. Şimdiden tşkler.Ekli dosyayı görüntüle arama.xlsm

 

[Huseyinkis]

Ekteki gibi denermisiniz.

Private Sub TextBox2_Change()
Dim sonsat As Long, Deg1 As String, hcr As Range, Aln As Range, Code As Boolean
Dim vsyf As Worksheet, renk

    Sheets("ARAMA").Activate
        
        If Range("E5") <> "" Then
            Deg1 = Range("E5").Value
            
        Else
            
            Exit Sub
        End If
        
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set vsyf = Sheets("VERİ")
    Range("A9:F300").ClearContents


    sonsat = vsyf.Range("A" & Rows.Count).End(xlUp).Row
    vsyf.Range("E2").AutoFilter
    
    vsyf.Range("E2").AutoFilter Field:=5, Criteria1:="=*" & Deg1 & "*"
    
    vsyf.Range("B2:F" & sonsat).SpecialCells(xlCellTypeVisible).Copy Range("B9")
    vsyf.Range("E2").AutoFilter


    sonsat = Range("E" & Rows.Count).End(xlUp).Row
          Set Aln = Range("E10:E" & sonsat)
        
    For Each hcr In Aln
        renk = InStr(renk + 1, hcr.Text, Deg1)
        Do
            If renk > 0 Then
                hcr.Characters(Start:=renk, Length:=Len(Deg1)).Font.ColorIndex = 3
            End If
            renk = InStr(renk + 1, hcr.Text, Deg1)
        Loop While renk > 0
    Next hcr

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub