Sayfada Soyada göre arama

[mustafa7691]

Sn Dostlar.bu ekteki form sağlık ocağında kullandığımız ev halkı tesbit formu.ve 10 000 civarı kişi kaydı oluyor.YAni alt alta satırlar halinde.ben bu sayfada soy ada göre bir user form ile arama yaptırıp kişiyi bulursa o satıra excel cursounun gelmesini ,yok bulamazsa bir uyarı vermesini istiyorum.ben bir buton ile kendimce bir user form yerleştirdim ama ilgili kodu yazamadım.forumda oldukçada gezmeme rağmen kendime uyarlayabildiğim bir kod bulamadım yada anlamadığım için yapamadım.ilgilenirseniz memnun olurum.Saygılarımla

 

[Orion1]

Merhaba.
Bu işlemi bul ile yapabilirsiniz.
Ctrl+F tuşlarına basınız.Aranacak kişiyi yazınız .O kadar.

 

[Orion1]

Command Butona aşağıdaki kodu yazrak deneyebilirsiniz.

Private Sub BUL_Click()
Sheets("Sayfa1").Select
sonsat = Cells(65536, "F").End(xlUp).Row
If sonsat < 3 Then Exit Sub
Set k = Range("F3:F" & sonsat).Find(SOYADI.Value, lookat:=xlWhole)
If Not k Is Nothing Then
    Cells(k.Row, "F").Select
End If
Set k = Nothing
End Sub

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub BUL_Click()
For i = 2 To [F65536].End(3).Row
If Range("F" & i).Value = SOYADI.Value Then
Range("F" & i).Select
Exit Sub
End If
Next
MsgBox "Aranılan veri bulunamamıştır"
End Sub

 

[hamitcan]

Bir tane de benden.

Private Sub BUL_Click()
Set bull = Columns("f").Find(SOYADI, LookAt:=xlWhole)
If bull Is Nothing Then MsgBox "Bu soyadına sahip kimse yok": Exit Sub
 bull.Activate
 Range(Cells(ActiveCell.Rows.Row, 1), ActiveCell.Offset(0, 18).Address).Select
Cells(ActiveCell.Row, "F").Activate
End Sub

 

[mustafa7691]

çok teşekkür ederim işim görüldü sayenizde saygılarımla

 

[DeliBalta58]

Müsadelerinizle bir Ekleme ve bir soru sormak istiyorum

Eklemem : Eğer hücreye veri girişi yapılırken Büyük harf - Küçük harf dikkat edilmeden yazıldığı düşünülerek arama kriterimizi önce ya büyük harf yada küçük harf yapmamız gerekmezmi ?

Private Sub BUL_Click()
For i = 2 To [F65536].End(3).Row
If StrConv(Range("F" & i).Value, vbUpperCase) = StrConv(SOYADI.Value, vbUpperCase) Then
Range("F" & i).Select
Exit Sub
End If
Next
MsgBox "Aranılan veri bulunamamıştır"
End Sub

Sorum İse Aynı Soyisimde başkaları olduğu zaman ne olacak?

Bu kayıtları bir listbox'a aktarabilirmiyiz?

 

[hamitcan]

Koda, ekleme yapma konusunda bir geliştirme yapılabilir. Diğer örneklerde büyük-küçük harf duyarlılığı bulunmaktadır.

Sorunuz için, bir buton daha oluşturulup sonraki soyadı tespit edilebilir. Ayrıca listbox içerisine bu kayıtları aktarabilirsiniz.
Bunun için "Listbox'da süzme" olarak forumda aratırsanız birçok örnek bulabilirsiniz.

 

[ZeHir25]

userform arama butonu düzenlemede yardımcı olurmusunuz

Private Sub bul_Click()
Dim say, adet, miktar As Integer
Dim sonuc As String
Dim hucre, hcr As Range

If OptionButton1.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın ismini veya ilk harflerini girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 7).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm İsim Listesi"
bultxt.SetFocus
End If
End If
End If

If OptionButton2.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("C3"), Range("C" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 6).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("C3"), Range("C" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Telefon Numarası - 1 Kayıtları"
bultxt.SetFocus
End If
End If
End If

If OptionButton3.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("D3"), Range("D" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 5).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("D3"), Range("D" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Telefon Numarası - 2 Kayıtları"
bultxt.SetFocus
End If
End If
End If

If OptionButton4.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("E3"), Range("E" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 4).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("E3"), Range("E" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Dahili Numaralar Listesi"
bultxt.SetFocus
End If
End If
End If

If OptionButton5.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("F3"), Range("F" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 3).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("F3"), Range("F" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Faks Numaraları Listesi"
bultxt.SetFocus
End If
End If
End If

If OptionButton6.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın telefon numarasını veya ilk rakamlarını girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("G3"), Range("G" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 2).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("G3"), Range("G" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm Cep Telefonu Kayıtları"
bultxt.SetFocus
End If
End If
End If

bultxt.SetFocus
End Sub
Private Sub bultxt_Enter()
anaadi.Value = ""
anatel1.Value = ""
anatel2.Value = ""
anadahili.Value = ""
anafaks.Value = ""
anacep.Value = ""
anaadres.Value = ""
End Sub

merhaba arkadaşlar kolay gelsin.. bende böyle bi bul komutu var ama büyük küçük harf duyarlılığı var birde samet keleş i aramak istiyorum samet yazınca buluyor ama keleş yazınca bulamıyor.. bulmasını istiyorum telefon rehberi olarak kullanıyorum yardımcı olursanız çok makbule geçer..

yardımcı olacak arkadaşlara şimdiden teşekkür ediyorum

 

[ZeHir25]

ve yukardaki bul komutu şu analist de gözükmektedir

Private Sub analist_Click()
Dim adet As Integer
bultxt.Value = ""
On Error Resume Next
If OptionButton1 = True Then
Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2)).Select
Selection.Find(analist.Value, ActiveCell, , xlWhole).Activate
anaadi.Value = ActiveCell.Value
anatel1.Value = ActiveCell.Offset(0, 1).Value
anatel2.Value = ActiveCell.Offset(0, 2).Value
anadahili.Value = ActiveCell.Offset(0, 3).Value
anafaks.Value = ActiveCell.Offset(0, 4).Value
anacep.Value = ActiveCell.Offset(0, 5).Value
anaadres.Value = ActiveCell.Offset(0, 6).Value
End If
If OptionButton2 = True Then
Range(Range("C3"), Range("C" & Sayfa1.[A1].Value + 2)).Select
Selection.Find(analist.Value, ActiveCell, , xlWhole).Activate
anaadi.Value = ActiveCell.Offset(0, -1).Value
anatel1.Value = ActiveCell.Value
anatel2.Value = ActiveCell.Offset(0, 1).Value
anadahili.Value = ActiveCell.Offset(0, 2).Value
anafaks.Value = ActiveCell.Offset(0, 3).Value
anacep.Value = ActiveCell.Offset(0, 4).Value
anaadres.Value = ActiveCell.Offset(0, 5).Value
End If

If OptionButton3 = True Then
Range(Range("D3"), Range("D" & Sayfa1.[A1].Value + 2)).Select
Selection.Find(analist.Value, ActiveCell, , xlWhole).Activate
anaadi.Value = ActiveCell.Offset(0, -2).Value
anatel1.Value = ActiveCell.Offset(0, -1).Value
anatel2.Value = ActiveCell.Value
anadahili.Value = ActiveCell.Offset(0, 1).Value
anafaks.Value = ActiveCell.Offset(0, 2).Value
anacep.Value = ActiveCell.Offset(0, 3).Value
anaadres.Value = ActiveCell.Offset(0, 4).Value
End If

If OptionButton4 = True Then
Range(Range("E3"), Range("E" & Sayfa1.[A1].Value + 2)).Select
Selection.Find(analist.Value, ActiveCell, , xlWhole).Activate
anaadi.Value = ActiveCell.Offset(0, -3).Value
anatel1.Value = ActiveCell.Offset(0, -2).Value
anatel2.Value = ActiveCell.Offset(0, -1).Value
anadahili.Value = ActiveCell.Value
anafaks.Value = ActiveCell.Offset(0, 1).Value
anacep.Value = ActiveCell.Offset(0, 2).Value
anaadres.Value = ActiveCell.Offset(0, 3).Value
End If

If OptionButton5 = True Then
Range(Range("F3"), Range("F" & Sayfa1.[A1].Value + 2)).Select
Selection.Find(analist.Value, ActiveCell, , xlWhole).Activate
anaadi.Value = ActiveCell.Offset(0, -4).Value
anatel1.Value = ActiveCell.Offset(0, -3).Value
anatel2.Value = ActiveCell.Offset(0, -2).Value
anadahili.Value = ActiveCell.Offset(0, -1).Value
anafaks.Value = ActiveCell
anacep.Value = ActiveCell.Offset(0, 1).Value
anaadres.Value = ActiveCell.Offset(0, 2).Value
End If

If OptionButton6 = True Then
Range(Range("G3"), Range("G" & Sayfa1.[A1].Value + 2)).Select
Selection.Find(analist.Value, ActiveCell, , xlWhole).Activate
anaadi.Value = ActiveCell.Offset(0, -5).Value
anatel1.Value = ActiveCell.Offset(0, -4).Value
anatel2.Value = ActiveCell.Offset(0, -3).Value
anadahili.Value = ActiveCell.Offset(0, -2).Value
anafaks.Value = ActiveCell.Offset(0, -1).Value
anacep.Value = ActiveCell
anaadres.Value = ActiveCell.Offset(0, 1).Value
End If

End Sub
Private Sub OptionButton1_Click()
Dim hucre As Range
Label9.Caption = "Telefon Rehberi Tüm İsim Listesi"
analist.Clear
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
bultxt = Empty
bultxt.SetFocus
End Sub
Private Sub OptionButton2_Click()
Dim hucre As Range
Label9.Caption = "Telefon Rehberi Tüm Telefon Numaraları - 1 Kayıtları"
analist.Clear
For Each hucre In Range(Range("C3"), Range("C" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
bultxt = Empty
bultxt.SetFocus
End Sub
Private Sub OptionButton3_Click()
Dim hucre As Range
Label9.Caption = "Telefon Rehberi Tüm Telefon Numaraları - 2 Kayıtları"
analist.Clear
For Each hucre In Range(Range("D3"), Range("D" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
bultxt = Empty
bultxt.SetFocus
End Sub
Private Sub OptionButton4_Click()
Dim hucre As Range
Label9.Caption = "Telefon Rehberi Tüm Dahili Numaralar Listesi"
analist.Clear
For Each hucre In Range(Range("E3"), Range("E" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
bultxt = Empty
bultxt.SetFocus
End Sub
Private Sub OptionButton5_Click()
Dim hucre As Range
Label9.Caption = "Telefon Rehberi Tüm Faks Numaraları Listesi"
analist.Clear
For Each hucre In Range(Range("F3"), Range("F" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
bultxt = Empty
bultxt.SetFocus
End Sub
Private Sub OptionButton6_Click()
Dim hucre As Range
Label9.Caption = "Telefon Rehberi Tüm Cep Telefonu Kayıtları"
analist.Clear
For Each hucre In Range(Range("G3"), Range("G" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
bultxt = Empty
bultxt.SetFocus
End Sub
Private Sub bultxt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If OptionButton2.Value = True Or OptionButton3.Value = True _
Or OptionButton4.Value = True Or OptionButton5.Value = True Or OptionButton6.Value = True Then
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0
End If
End If
End Sub