• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

C

comand0

Katılım
14 Şubat 2012
Mesajlar
25
Excel Vers. ve Dili
mic. of. 2016
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.
 
=CONCATENATE ile isim soy ismi bir sütunda birleştirip ad soyad şeklinde arattırın birde örnek dosya ekler misiniz.
 
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
 
Hocam deneyemedik :) Altınüyeliği aktif etmediler henüz.
 
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ü.
 
comand0' Alıntı:
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ü.
Genişletmek için tıkla ...
benim paylaşmış olduğum çalışma verileri kaydettiğiniz sayfada verileri süz mantığı ile çalışıyor
 
valla hocam deneyemedim. admine msj attım ama üyelik aktif edilmedi henüz.
 
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.
 
Merhaba
Ek dosyayı denermisiniz?
Butona gerek kalmadan ad veya soyadları harf harf; bulunmuş adlar (tam yazılmamış adlar olsada) varsa soyadlarını eleyip listeleyecektir
we.tl

denemem.zip

1 file sent via WeTransfer, the simplest way to send your files around the world
we.tl we.tl
 
Hocam, daha iyi olmuş aslında... Ancak sayfa ekleyince arama yapmıyor. Sadece açık sayfada işlem yapıyor sanırım?
 
Userformdaki tüm kodları aşağı gibi "s1" tanımlası eklenmiş şekliyle değiştirerek deneyin
Kod: 
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
 
PLİNT' Alıntı:
Userformdaki tüm kodları aşağı gibi "s1" tanımlası eklenmiş şekliyle değiştirerek deneyin
Kod: 
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
Genişletmek için tıkla ...
Ç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 :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst