Barons
Altın Üye
- Katılım
- 14 Mayıs 2005
- Mesajlar
- 967
- Excel Vers. ve Dili
- Microsoft Ofis 365
- Altın Üyelik Bitiş Tarihi
- 06-01-2040
Merhaba
Aşağıdaki kod'la hem kelime hemde rakam araması yapıyorum.Ancak şöyle bir sorunum var.
Aramayı tüm sayfalarda yapıyor.Oysa ben sadece diyelim "tablo" adlı sayfada arama yapmasını istiyorum.
yardımcı olacak arkadaşlara şimdiden teşekkürler
Sub FindData2()
On Error Resume Next
Dim wsSheet As Worksheet
Dim rFound As Range
Dim MyData As Variant
MyData = InputBox("NO VEYA ARANILAN KELİMEYİ YAZINIZ.")
If MyData = False Or MyData = "" Then End
For Each wsSheet In ActiveWorkbook.Worksheets
Set rFound = wsSheet.UsedRange. _
Find(What:=CStr(MyData), LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
If Not rFound Is Nothing Then
bln = bln + 1
First = rFound.Address
Do
Application.Goto rFound
ActiveCell.EntireRow.Select
Selection.Interior.ColorIndex = 6
ActiveCell.Select
Selection.Interior.ColorIndex = 4
ActiveCell.Select
s = " İlgili lab." & " " & ActiveCell.Offset(0, 8).Value & " / " & "Deney Ücreti" & " " & ActiveCell.Offset(0, 9).Value & " " & "YTL" & " / " & " Kapsam " & ActiveCell.Offset(0, 10).Value
sor = MsgBox(s, vbYesNo)
If sor = vbNo Then Exit Sub
'MsgBox " Deney Ücreti" & " " & ActiveCell.Offset(0, 9).Value & " " & "YTL" & " " & " Kapsam " & ActiveCell.Offset(0, 10).Value
'If MsgBox("Aramaya devam edilsin mi?", vbInformation + vbYesNo, "Arama Formu ") = vbNo Then End
Set rFound = wsSheet.UsedRange.FindNext(rFound)
Loop While Not rFound Is Nothing And rFound.Address <> First
End If
Next wsSheet
'MsgBox s
If bln = 0 Then: MsgBox "Aradığınız veri bulunamadı, !", vbExclamation, "Arama Sonucu "
End Sub
Aşağıdaki kod'la hem kelime hemde rakam araması yapıyorum.Ancak şöyle bir sorunum var.
Aramayı tüm sayfalarda yapıyor.Oysa ben sadece diyelim "tablo" adlı sayfada arama yapmasını istiyorum.
yardımcı olacak arkadaşlara şimdiden teşekkürler
Sub FindData2()
On Error Resume Next
Dim wsSheet As Worksheet
Dim rFound As Range
Dim MyData As Variant
MyData = InputBox("NO VEYA ARANILAN KELİMEYİ YAZINIZ.")
If MyData = False Or MyData = "" Then End
For Each wsSheet In ActiveWorkbook.Worksheets
Set rFound = wsSheet.UsedRange. _
Find(What:=CStr(MyData), LookIn:=xlValues, _
LookAt:=xlPart, MatchCase:=False)
If Not rFound Is Nothing Then
bln = bln + 1
First = rFound.Address
Do
Application.Goto rFound
ActiveCell.EntireRow.Select
Selection.Interior.ColorIndex = 6
ActiveCell.Select
Selection.Interior.ColorIndex = 4
ActiveCell.Select
s = " İlgili lab." & " " & ActiveCell.Offset(0, 8).Value & " / " & "Deney Ücreti" & " " & ActiveCell.Offset(0, 9).Value & " " & "YTL" & " / " & " Kapsam " & ActiveCell.Offset(0, 10).Value
sor = MsgBox(s, vbYesNo)
If sor = vbNo Then Exit Sub
'MsgBox " Deney Ücreti" & " " & ActiveCell.Offset(0, 9).Value & " " & "YTL" & " " & " Kapsam " & ActiveCell.Offset(0, 10).Value
'If MsgBox("Aramaya devam edilsin mi?", vbInformation + vbYesNo, "Arama Formu ") = vbNo Then End
Set rFound = wsSheet.UsedRange.FindNext(rFound)
Loop While Not rFound Is Nothing And rFound.Address <> First
End If
Next wsSheet
'MsgBox s
If bln = 0 Then: MsgBox "Aradığınız veri bulunamadı, !", vbExclamation, "Arama Sonucu "
End Sub