A-B Sütunlarında isim soy isim ara

[comand0]

Herkese kolay gelsin,

fihrist sayfası oluşturdum. buraya formlar ile isim soy isim dosya no şeklinde kayıtları yapıyorum. ancak arama formuda oluşturmak istiyorum.

sadece isim ve soy isimden arama yaptırmak istiyorum. sayfa ismi fihrist arama yapılacak sütunlar a ve b sütunları. yardımcı olursanız çok sevinirim. şimdiden teşekkürler.

 

[mzsakall]

=CONCATENATE ile isim soy ismi bir sütunda birleştirip ad soyad şeklinde arattırın birde örnek dosya ekler misiniz.

 

[comand0]

Hocam pek müsait olamadım, kusura bakmayın. Evrak linktedir. Bakınca anlayacaksınız. Ne yaptıysam olmadı

İndir deneme

Dosyayı indir deneme

dosya.co

 

[metin_0606]

Hocam pek müsait olamadım, kusura bakmayın. Evrak linktedir. Bakınca anlayacaksınız. Ne yaptıysam olmadı

İndir deneme

Dosyayı indir deneme

dosya.co

[/QU
Deneyiniz

 

[comand0]

Hocam deneyemedik Altınüyeliği aktif etmediler henüz.

 

[metin_0606]

Hocam deneyemedik Altınüyeliği aktif etmediler henüz.

arama formunu userformlamı yapmak istiyorsunuz yoksa verileri girdiğiniz sayfadamı

 

[comand0]

hocam fihrist kayıt formu var, o deneme attığım sayfada yok. o form, a, b, c, d sütunlarına bilgileri giriyor. isim soyisim dosya no baba adı şeklinde. bu form sadece kayıt ettiğim bilgileri arattırmak istiyorum. 1000 e yakın kayıt oluyor çünkü.

 

[metin_0606]

hocam fihrist kayıt formu var, o deneme attığım sayfada yok. o form, a, b, c, d sütunlarına bilgileri giriyor. isim soyisim dosya no baba adı şeklinde. bu form sadece kayıt ettiğim bilgileri arattırmak istiyorum. 1000 e yakın kayıt oluyor çünkü.

benim paylaşmış olduğum çalışma verileri kaydettiğiniz sayfada verileri süz mantığı ile çalışıyor

 

[comand0]

valla hocam deneyemedim. admine msj attım ama üyelik aktif edilmedi henüz.

 

[metin_0606]

valla hocam deneyemedim. admine msj attım ama üyelik aktif edilmedi henüz.

ekran görüntüsü bu şekilde

 

[comand0]

mantık şu hocam. sağlık dosyası kaydedip fiziki dosyaya numara veriyorum. arama ekranında da isim soy isim olarak arama yaptığımda dosya numarası ve baba adını görerek fiziki dosyaya ulaşmak istiyorum.

 

[comand0]

benim paylaşmış olduğum çalışma verileri kaydettiğiniz sayfada verileri süz mantığı ile çalışıyor

Attığınız dosyayı denedim hocam ancak sayfada yapmşsınız. Userform da textboxlardan arama yaptırmak istemiştim ben

 

[PLİNT]

Merhaba
Ek dosyayı denermisiniz?
Butona gerek kalmadan ad veya soyadları harf harf; bulunmuş adlar (tam yazılmamış adlar olsada) varsa soyadlarını eleyip listeleyecektir

denemem.zip

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[comand0]

Hocam, daha iyi olmuş aslında... Ancak sayfa ekleyince arama yapmıyor. Sadece açık sayfada işlem yapıyor sanırım?

 

[PLİNT]

Userformdaki tüm kodları aşağı gibi "s1" tanımlası eklenmiş şekliyle değiştirerek deneyin

Private Sub txtadi_Change()
On Error Resume Next
txtadi = Evaluate("=büyükharf(""" & txtadi & """)")
txtadi = Evaluate("=upper(""" & txtadi & """)")
txtsoy = ""
Dim bul As Range, f As Long, s1 As Worksheet
Set s1 = Sheets("fihrist")
listsonuc.Clear
Set bul = s1.Range("A1:A65536").Find(txtadi & "*", , xlValues, xlPart, xlByRows, xlNext, False, False)
If Not bul Is Nothing Then
    Application.EnableEvents = False
    fg = bul.Address
    Do
If LCase(bul.Value) Like LCase(txtadi & "*") And bul.Row <> 1 Then
With listsonuc
.AddItem s1.Cells(bul.Row, "A").Text
f = .ListCount - 1
.List(f, 1) = s1.Cells(bul.Row, "B").Text
.List(f, 2) = s1.Cells(bul.Row, "C").Text
End With
End If
 Set bul = s1.Range("A1:A65536").FindNext(bul)
    Loop While Not bul Is Nothing And bul.Address <> fg
    Application.EnableEvents = True
End If
End Sub

Private Sub txtsoy_Change()
If txtsoy = "" Then Call txtadi_Change: Exit Sub
On Error Resume Next
txtsoy = Evaluate("=büyükharf(""" & txtsoy & """)")
txtsoy = Evaluate("=upper(""" & txtsoy & """)")
If txtadi = "" Then Call ara1
If txtadi <> "" Then Call ara2
End Sub
Sub ara1()
Dim bul As Range, f As Long, s1 As Worksheet
listsonuc.Clear
Set s1 = Sheets("fihrist")
Set bul = s1.Range("B1:B65536").Find(txtsoy & "*", , xlValues, xlPart, xlByRows, xlNext, False, False)
If Not bul Is Nothing Then
    Application.EnableEvents = False
    fg = bul.Address
    Do
If LCase(bul.Value) Like LCase(txtsoy & "*") And bul.Row <> 1 Then
With listsonuc
.AddItem s1.Cells(bul.Row, "A").Text
f = .ListCount - 1
.List(f, 1) = s1.Cells(bul.Row, "B").Text
.List(f, 2) = s1.Cells(bul.Row, "C").Text
End With
End If
 Set bul = s1.Range("B1:B65536").FindNext(bul)
    Loop While Not bul Is Nothing And bul.Address <> fg
    Application.EnableEvents = True
End If
End Sub

Sub ara2()
With listsonuc
For p = .ListCount - 1 To 0 Step -1
If LCase(.List(p, 1)) Like LCase(txtsoy & "*") = False Then .RemoveItem (p)
Next
End With
End Sub
Private Sub UserForm_Initialize()
With listsonuc
.ColumnCount = 3
.ColumnWidths = "60,60,30"
End With
End Sub

Ayrıca
Private Sub txtadi_Change()
Başlığı altındaki şu satırda
If LCase(bul.Value) Like LCase(txtadi & "*") And bul.Row <> 1 Then
işaretli bölümü

If LCase(bul.Value) Like LCase("*" & txtadi & "*") And bul.Row <> 1 Then
gibi değiştirerek isim içindede arama yaptırabilirsiniz

 

[comand0]

Userformdaki tüm kodları aşağı gibi "s1" tanımlası eklenmiş şekliyle değiştirerek deneyin

Private Sub txtadi_Change()
On Error Resume Next
txtadi = Evaluate("=büyükharf(""" & txtadi & """)")
txtadi = Evaluate("=upper(""" & txtadi & """)")
txtsoy = ""
Dim bul As Range, f As Long, s1 As Worksheet
Set s1 = Sheets("fihrist")
listsonuc.Clear
Set bul = s1.Range("A1:A65536").Find(txtadi & "*", , xlValues, xlPart, xlByRows, xlNext, False, False)
If Not bul Is Nothing Then
    Application.EnableEvents = False
    fg = bul.Address
    Do
If LCase(bul.Value) Like LCase(txtadi & "*") And bul.Row <> 1 Then
With listsonuc
.AddItem s1.Cells(bul.Row, "A").Text
f = .ListCount - 1
.List(f, 1) = s1.Cells(bul.Row, "B").Text
.List(f, 2) = s1.Cells(bul.Row, "C").Text
End With
End If
 Set bul = s1.Range("A1:A65536").FindNext(bul)
    Loop While Not bul Is Nothing And bul.Address <> fg
    Application.EnableEvents = True
End If
End Sub

Private Sub txtsoy_Change()
If txtsoy = "" Then Call txtadi_Change: Exit Sub
On Error Resume Next
txtsoy = Evaluate("=büyükharf(""" & txtsoy & """)")
txtsoy = Evaluate("=upper(""" & txtsoy & """)")
If txtadi = "" Then Call ara1
If txtadi <> "" Then Call ara2
End Sub
Sub ara1()
Dim bul As Range, f As Long, s1 As Worksheet
listsonuc.Clear
Set s1 = Sheets("fihrist")
Set bul = s1.Range("B1:B65536").Find(txtsoy & "*", , xlValues, xlPart, xlByRows, xlNext, False, False)
If Not bul Is Nothing Then
    Application.EnableEvents = False
    fg = bul.Address
    Do
If LCase(bul.Value) Like LCase(txtsoy & "*") And bul.Row <> 1 Then
With listsonuc
.AddItem s1.Cells(bul.Row, "A").Text
f = .ListCount - 1
.List(f, 1) = s1.Cells(bul.Row, "B").Text
.List(f, 2) = s1.Cells(bul.Row, "C").Text
End With
End If
 Set bul = s1.Range("B1:B65536").FindNext(bul)
    Loop While Not bul Is Nothing And bul.Address <> fg
    Application.EnableEvents = True
End If
End Sub

Sub ara2()
With listsonuc
For p = .ListCount - 1 To 0 Step -1
If LCase(.List(p, 1)) Like LCase(txtsoy & "*") = False Then .RemoveItem (p)
Next
End With
End Sub
Private Sub UserForm_Initialize()
With listsonuc
.ColumnCount = 3
.ColumnWidths = "60,60,30"
End With
End Sub

Ayrıca
Private Sub txtadi_Change()
Başlığı altındaki şu satırda
If LCase(bul.Value) Like LCase(txtadi & "*") And bul.Row <> 1 Then
işaretli bölümü

If LCase(bul.Value) Like LCase("*" & txtadi & "*") And bul.Row <> 1 Then
gibi değiştirerek isim içindede arama yaptırabilirsiniz

Çok teşekkür ettim. Elinize sağlık. Peki listbox sütun sayısını 5 e çıkarabiliyor muyuz hocam. vaktinizi alıyorum ama