Seçenekli Ara Bul

[wishm]

Değerli site üyeleri epeyce uğraştım ama bir türlü işin içinden çıkamadım.

Müşteri takip programı üzerinde çalışıyorum. Olmazsa olmazı "ARAMA" kısmı elbette. Ancak listem çok uzun olduğu için kimi zaman "MŞTERİ NUMARASI" na göre, kimi zaman "TC KİMLİK NUMARASI" na göre kimi zamanda "AD VE SOYAD" a göre arama yapmam gerekiyor. Ekli dosyada çalışmamı gönderdim. Yapmak istediğim yukarıda belirlediğim kriterlerden herhangi birini UserForm üzerinde yer alan "OptionButton" seçeneği ile seçerek ilgili "TextBox1" e aranacak değeri girmek ve devamında da "BUL" deyince aranan değere ait verileri "TextBox2", "TextBox3" ve "TextBox4" ' e yazdırmak istiyorum.

Yardımlarınız ve yanıtlarınız için şimdiden teşekkür ederim. Saygılarımla.

 

[Orion1]

Ekli dosyayı inceleyiniz.

Private Sub CommandButton1_Click()
If OptionButton1.Value = True Then Call bul_59(TextBox2)
If OptionButton2.Value = True Then Call bul_59(TextBox3)
If OptionButton3.Value = True Then Call bul_59(TextBox4)
End Sub

Private Sub ListBox1_Click()
If ListBox1.ColumnCount = 0 Then Exit Sub
TextBox1.Text = ListBox1.Column(2)
End Sub

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 3
OptionButton1.Value = True
TextBox2.SetFocus
End Sub
Private Sub bul_59(ByVal txt As Control)
Dim sut As String, k As Range, adr As String, myarr(), a As Long
Dim sat As Long, deg
ListBox1.Clear
If txt.Text = "" Then Exit Sub
If txt.Name = "TextBox2" Then
    sut = "A"
    deg = CDbl(txt.Text)
    ElseIf txt.Name = "TextBox3" Then
    sut = "B"
    deg = CDbl(txt.Text)
    ElseIf txt.Name = "TextBox4" Then
    sut = "C"
    deg = txt.Text
End If
sat = Sheets("Sayfa1").Cells(65536, sut).End(xlUp).Row
ReDim myarr(1 To 3, 1 To 65536)
Set k = Sheets("Sayfa1").Range(sut & "2:" & sut & sat). _
Find(deg, , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        a = a + 1
        myarr(1, a) = Sheets("Sayfa1").Cells(k.Row, "A").Value
        myarr(2, a) = Sheets("Sayfa1").Cells(k.Row, "B").Value
        myarr(3, a) = Sheets("Sayfa1").Cells(k.Row, "C").Value
        Set k = Sheets("Sayfa1").Range(sut & "2:" & sut & sat).FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
    ReDim Preserve myarr(1 To 3, 1 To a)
    ListBox1.Column = myarr
End If
End Sub

 

[wishm]

Sayın Evren GİZLEN yanıtınız için teşekkür ederim. Dosyanın görselliğide çok güzel olmuş. Ancak arama sonucu elde edilen verilerin listbox' ta gösterilmesi yerine sorumda da belirttiğim üzere Textbox' lara yazdırılması mümkün değil mi acaba. Aranacak veriyi seçim kriterlerinin (OptionButton) üzerinde yer alan TextBox' a yazıp OptionButton' dan arama kriterini seçip Bul butonuna tıklatınca aranan veriyi UserForm' un sağında yer alan TextBox' lara yazdırmak mümkün olamaz mı? İlginiz ve yanıtınız için tekrar teşekkür ederim. Saygılarımla.

 

[Orion1]

Sayın Evren GİZLEN yanıtınız için teşekkür ederim. Dosyanın görselliğide çok güzel olmuş. Ancak arama sonucu elde edilen verilerin listbox' ta gösterilmesi yerine sorumda da belirttiğim üzere Textbox' lara yazdırılması mümkün değil mi acaba. Aranacak veriyi seçim kriterlerinin (OptionButton) üzerinde yer alan TextBox' a yazıp OptionButton' dan arama kriterini seçip Bul butonuna tıklatınca aranan veriyi UserForm' un sağında yer alan TextBox' lara yazdırmak mümkün olamaz mı? İlginiz ve yanıtınız için tekrar teşekkür ederim. Saygılarımla.

1 kişiden birden fazla veri olduğunda bu işinize yarayacaktır.
Bu listboxa tıklayarak tıkladığınız veriyi textboxa atabilirsiniz.
Dediğiniz için de bir tane hazırlayacam şimdi.

 

[Orion1]

İstediğiniz gibi onuda yaptım.
Dosya ektedir.

Private Sub CommandButton1_Click()
If OptionButton1.Value = True Then Call bul_59(OptionButton1)
If OptionButton2.Value = True Then Call bul_59(OptionButton2)
If OptionButton3.Value = True Then Call bul_59(OptionButton3)
End Sub

Private Sub ListBox1_Click()
If ListBox1.ColumnCount = 0 Then Exit Sub
TextBox1.Text = ListBox1.Column(2)
End Sub

Private Sub UserForm_Initialize()
OptionButton1.Value = True
TextBox1.SetFocus
End Sub
Private Sub bul_59(ByVal opt As Control)
Dim sut As String, k As Range
Dim sat As Long, deg
If TextBox1.Text = "" Then Exit Sub
If opt.Name = "OptionButton1" Then
    sut = "A"
    deg = CDbl(TextBox1.Text)
    ElseIf opt.Name = "OptionButton2" Then
    sut = "B"
    deg = CDbl(TextBox1.Text)
    ElseIf opt.Name = "OptionButton3" Then
    sut = "C"
    deg = TextBox1.Text
End If
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
sat = Sheets("Sayfa1").Cells(65536, sut).End(xlUp).Row
Set k = Sheets("Sayfa1").Range(sut & "2:" & sut & sat). _
Find(deg, , xlValues, xlWhole)
If Not k Is Nothing Then
    TextBox2.Text = Format(Sheets("Sayfa1").Cells(k.Row, "A").Value, "#,##0")
    TextBox3.Text = Format(Sheets("Sayfa1").Cells(k.Row, "B").Value, "#,##0")
    TextBox4.Text = Sheets("Sayfa1").Cells(k.Row, "C").Value
End If
End Sub

 

[wishm]

Hocam çok teşekkür ederim gerçekten işime yaradı. Ancak son olarak şunu yinelemek istiyorum aranacak verileri (Müşteri No, TC Kimlik No ve Ad Soyad) UserForm üzerinde bulunan kendi bölümleri yerine TextBox1' e yazarak arama yaptıramazmıyız ? (Örnek :Müşteri Numarasına göre arama yapılacaksa OptionButton' dan Müşteri Numarası seçilerek ve aranacak müşteri numarasını TextBox1' e yazarak aramak, yine aynı şekilde ad ve soyada göre arama yapılacaksa OptionaButton' dan ad ve soyad seçilerek ve ad ve soyadı yine TextBox1' e yazarak arama yaptırmak) mümkün olabilrimi? Teşekkür ederim. Saygılarımla.

 

[Orion1]

Hocam çok teşekkür ederim gerçekten işime yaradı. Ancak son olarak şunu yinelemek istiyorum aranacak verileri (Müşteri No, TC Kimlik No ve Ad Soyad) UserForm üzerinde bulunan kendi bölümleri yerine TextBox1' e yazarak arama yaptıramazmıyız ? (Örnek :Müşteri Numarasına göre arama yapılacaksa OptionButton' dan Müşteri Numarası seçilerek ve aranacak müşteri numarasını TextBox1' e yazarak aramak, yine aynı şekilde ad ve soyada göre arama yapılacaksa OptionaButton' dan ad ve soyad seçilerek ve ad ve soyadı yine TextBox1' e yazarak arama yaptırmak) mümkün olabilrimi? Teşekkür ederim. Saygılarımla.

Dosyayı günceledim.5 numaralı mesajdan indirebilirsiniz.

 

[wishm]

Hocam çok teşekkür ederim. Şimdi tam anlatmak istediğim gibi oldu. İlginiz ve yanıtlarınız için tekrar teşekkür ederim. Saygılarımla.

 

[Orion1]

Hocam çok teşekkür ederim. Şimdi tam anlatmak istediğim gibi oldu. İlginiz ve yanıtlarınız için tekrar teşekkür ederim. Saygılarımla.

Rica ederim.
İyi çalışmalar.

 

[cemal42]

İyi çalışmalar. Bu uygulamayı Textbox'ın "change" olayı için yapabilir misiniz?