bilemiyorum ama istersen belki bu kod işini görür.Sayfana bir tane commandbutton ekle ve kodları içine yerleştir.
Kod:
Dim MyStr As String, InfoMsg As String
Dim Rng1 As String, LookupValue As String
Dim MyQ As VbMsgBoxResult
Dim FoundRng As Variant
MyStr = Trim(Application.InputBox("Aranacak kelimeyi girin !", _
"Find exact match ..."))
If Not MyStr = "False" Then
Set FoundRng = Cells.Find(MyStr, LookIn:=xlValues, LookAt:=xlPart)
If Not FoundRng Is Nothing Then
Rng1 = FoundRng.Address
FoundRng.Activate
ResumeSub2:
If Right(FoundRng.Value, 1) <> " " Then LookupValue = FoundRng.Value & " "
MyData = Split(LookupValue, " ", , vbTextCompare)
For i = LBound(MyData) To UBound(MyData)
If MyData(i) = MyStr Then
InfoMsg = "Aranan metin " & FoundRng.Address(False, False) _
& " hücresinde bulundu." _
& vbCrLf & vbCrLf & "Bulunan hücrenin içeriği :" _
& vbCrLf & vbCrLf & FoundRng.Value & vbCrLf _
& vbCrLf & "Aramaya devam etmek istiyormusunuz ?"
MyQ = MsgBox(InfoMsg, vbInformation + vbYesNo, _
"Arama sonucu...")
If MyQ = vbYes Then GoTo ResumeSub1:
Exit Sub
End If
Next
Else
MsgBox "Aranan değer bulunamadı !", vbInformation, "Arama sonucu..."
Exit Sub
End If
ResumeSub1:
Set FoundRng = Cells.FindNext(FoundRng)
If Rng1 = FoundRng.Address Then
MsgBox "Aranan değerden başka bulunamadı !", vbInformation, _
"Arama sonucu..."
Exit Sub
End If
FoundRng.Activate
GoTo ResumeSub2:
End If
Set FoundRng = Nothing
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.