arama kutusu yapamıyorum

[eemrahsari]

Ustalarım ekteki dosyadaki gibi bir liste yapacağım ama arama kısmını yapamıyorum yardımcı olabilirmisiniz?

 

[halit3]

Ustalarım ekteki dosyadaki gibi bir liste yapacağım ama arama kısmını yapamıyorum yardımcı olabilirmisiniz?

Bu kodu denermisiniz.

Sub arabul()
Set Sh1 = Sheets("Sayfa1")
Dim aranan As String
Dim Rng As Range
aranan = Sh1.TextBox1.Text
If Trim(aranan) <> "" Then
With Sh1.Range("c6:d65000")
Set Rng = .Find(What:=aranan, After:=.Cells(1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
If Not Rng Is Nothing Then
Sh1.Cells(3, "b") = Sh1.Cells(Rng.Row, "b")
Sh1.Cells(3, "c") = Sh1.Cells(Rng.Row, "c")
Sh1.Cells(3, "d") = Sh1.Cells(Rng.Row, "d")
Sh1.Cells(3, "e") = Sh1.Cells(Rng.Row, "e")
Exit Sub
Else
MsgBox "Sonuç yok"
End If
End With
End If
End Sub

 

[eemrahsari]

Bu kodu denermisiniz.

Sub arabul()
Set Sh1 = Sheets("Sayfa1")
Dim aranan As String
Dim Rng As Range
aranan = Sh1.TextBox1.Text
If Trim(aranan) <> "" Then
With Sh1.Range("c6:d65000")
Set Rng = .Find(What:=aranan, After:=.Cells(1), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
If Not Rng Is Nothing Then
Sh1.Cells(3, "b") = Sh1.Cells(Rng.Row, "b")
Sh1.Cells(3, "c") = Sh1.Cells(Rng.Row, "c")
Sh1.Cells(3, "d") = Sh1.Cells(Rng.Row, "d")
Sh1.Cells(3, "e") = Sh1.Cells(Rng.Row, "e")
Exit Sub
Else
MsgBox "Sonuç yok"
End If
End With
End If
End Sub

ustam yapamadım ben bunu

 

[halit3]

Ekli dosyanızı kontrol ediniz.

 

[eemrahsari]

Ekli dosyanızı kontrol ediniz.

çok teşekkür ederim