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 ile bir userform üzerinde arama yaptırıyorum.Userform'a bir progress bar ilave etmek istiyorum..Arama süresine bağlı olarak böyle uygulama yapılabilirmi?
Tüm foruma selam ve saygılar
Sub FindData()
'Application.ScreenUpdating = False
Sheets("GTIP").Select
Dim wsSheet As Worksheet
Dim rFound As Range
Dim MyData As Variant
MyData = InputBox("ARANILAN KELİMEYİ YAZINIZ.")
If MyData = False Or MyData = "" Then End
Set wsSheet = Sheets("GTIP")
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
aaa = "Kapsam " & ActiveCell.Offset(0, 10).Value & " " & " Deney Ücreti" & " " & ActiveCell.Offset(0, 9).Value & " " & "YTL" & " " & Chr(10) & aaa
Set rFound = wsSheet.UsedRange.FindNext(rFound)
Loop While Not rFound Is Nothing And rFound.Address <> First
End If
MsgBox aaa
If bln = 0 Then: MsgBox "Aradığınız veri bulunamadı, !", vbExclamation, "Arama Sonucu "
End Sub
Aşağıdaki kod ile bir userform üzerinde arama yaptırıyorum.Userform'a bir progress bar ilave etmek istiyorum..Arama süresine bağlı olarak böyle uygulama yapılabilirmi?
Tüm foruma selam ve saygılar
Sub FindData()
'Application.ScreenUpdating = False
Sheets("GTIP").Select
Dim wsSheet As Worksheet
Dim rFound As Range
Dim MyData As Variant
MyData = InputBox("ARANILAN KELİMEYİ YAZINIZ.")
If MyData = False Or MyData = "" Then End
Set wsSheet = Sheets("GTIP")
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
aaa = "Kapsam " & ActiveCell.Offset(0, 10).Value & " " & " Deney Ücreti" & " " & ActiveCell.Offset(0, 9).Value & " " & "YTL" & " " & Chr(10) & aaa
Set rFound = wsSheet.UsedRange.FindNext(rFound)
Loop While Not rFound Is Nothing And rFound.Address <> First
End If
MsgBox aaa
If bln = 0 Then: MsgBox "Aradığınız veri bulunamadı, !", vbExclamation, "Arama Sonucu "
End Sub