Texbox ile arama yapma sorunu

[serhata21]

forumda aradım ama örneklerle verildiği için örneklerin linki bozuktu. bende sizlere danışmak istedim..
------------------------------- sorun bu ---------------------------------
userformda 3 tane texbox ve 1 tanede buton var.
1. texbox ile aranan ismi yazıp butona bastığımda eğer varsa aranan kişinin adını texbox 2 soyadını texbox3 e aktarmasını istiyorum yardım ederseniz sevinirim..

saygılarımla

Ekli dosyayı görüntüle deneme.xls

 

[fedeal]

Çalışmada userform yok anlattıgınız kadarıyla alttaki kod işnizi görür ancak aynı isimden birden fazla varsa ilk kaydı alır.

Private Sub CommandButton1_Click()
Set bul = Sheets("sayfa1").Range("a:a").Find(TextBox1)
If Not bul Is Nothing Then
TextBox2.Text = Sheets("sayfa1").Range("a" & bul.Row).Value
TextBox3.Text = Sheets("sayfa1").Range("b" & bul.Row).Value
End If
End Sub

 

[fedeal]

Alternatif olması için bir çalışma ekledim, textbox1 listboxu süzüyor (harf yazdıkça) listboxtan çifttıkla textboxlara istedigmiz veriyi alıyoruz.

 

[serhata21]

ustad teşekür ederim..
walla 2 aydır yapamıyordum sayende projem tamamlandı..

 

[fedeal]

ricaederim , iyi çalışmalar.

 

[serhata21]

usta bişi daha soracam..
şimdi ben toplam 8 sütun kullanacam ama senin kod ile sadece 2 sütun kullanılıyor ve 3. sütuna izin vermiyor..
kod bu düzeltirsen sevinirim

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ListBox1.ListIndex = 0 Then Exit Sub
TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 0)
TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 1)
End Sub

 

[fedeal]

usta bişi daha soracam..
şimdi ben toplam 8 sütun kullanacam ama senin kod ile sadece 2 sütun kullanılıyor ve 3. sütuna izin vermiyor..
kod bu düzeltirsen sevinirim

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ListBox1.ListIndex = 0 Then Exit Sub
TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 0)
TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 1)
End Sub

Aslında listboxun kodu o degil kodları alttakilerle değiştir.

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ListBox1.ListIndex = 0 Then Exit Sub
TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 0)
TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 1)
TextBox4.Text = ListBox1.List(ListBox1.ListIndex, 2)
TextBox5.Text = ListBox1.List(ListBox1.ListIndex, 3)
TextBox6.Text = ListBox1.List(ListBox1.ListIndex, 4)
TextBox7.Text = ListBox1.List(ListBox1.ListIndex, 5)
TextBox8.Text = ListBox1.List(ListBox1.ListIndex, 6)
TextBox9.Text = ListBox1.List(ListBox1.ListIndex, 7)
End Sub

Private Sub TextBox1_Change()
Set sf = Sheets("sayfa1")
ListBox1.Clear
ListBox1.ColumnCount = 8
ReDim fdl(1 To 8, 1 To 1)
a = a + 1
ReDim Preserve fdl(1 To 8, 1 To a)
For k = 1 To 8
fdl(k, a) = sf.Cells(1, k)
Next k
For i = 2 To sf.Cells(65536, "A").End(xlUp).Row
deg1 = UCase(Replace(Replace(sf.Cells(i, 1), "ı", "I"), "i", "İ"))
deg2 = UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ"))
If deg2 = Left(deg1, Len(deg2)) Then
a = a + 1
ReDim Preserve fdl(1 To 8, 1 To a)
For k = 1 To 8
fdl(k, a) = sf.Cells(i, k)
Next k
End If
Next i
If a > 0 Then ListBox1.Column = fdl
Erase fdl
End Sub

 

[serhata21]

abicim sen en iyisi bir deneme excel dosyası yap
yapamadım

 

[fedeal]

dosya ekte,

 

[serhata21]

Tşk ederim aynen istediğim gibi

 

[serhata21]

öncelikle cevaplarınız ve yazdığım konuyu öneme aldığınız için teşekür ederim..
eğer verdiğiniz deneme excel çalışmasına değiştirme ve kaydetme butonları ekliyip aktif hale getirseniz daha iyi olur ben denedim hep hata veriyor..:S
run-time error "381":S
değiştir butonuna verdiğim kod bu..

For L = 1 To 10
If Controls("TextBox" & L).Text = "" Then
MsgBox "LÜTFEN " & Sheets("Sayfa1").Cells(1, L).Value & " GİRİNİZ.", , "EXCEL.WEB.TR"
Exit Sub
End If
Next
Set ARA = Sheets("Sayfa1").Range("A:A").Find(TextBox10)
If Not ARA Is Nothing Then
For T = 1 To 10
Sheets("Sayfa1").Cells(ARA.Row, T).Value = Controls("TextBox" & T).Text
Next
Else
MsgBox "Asıl Esas " & TextBox10.Text & " Veri Tabanında Yok...", , "EXCEL.WEB"
End If

düzeltebilriseniz sevinirim..

 

[fedeal]

öncelikle cevaplarınız ve yazdığım konuyu öneme aldığınız için teşekür ederim..
eğer verdiğiniz deneme excel çalışmasına değiştirme ve kaydetme butonları ekliyip aktif hale getirseniz daha iyi olur ben denedim hep hata veriyor..:S
run-time error "381":S
değiştir butonuna verdiğim kod bu..

For L = 1 To 10
If Controls("TextBox" & L).Text = "" Then
MsgBox "LÜTFEN " & Sheets("Sayfa1").Cells(1, L).Value & " GİRİNİZ.", , "EXCEL.WEB.TR"
Exit Sub
End If
Next
Set ARA = Sheets("Sayfa1").Range("A:A").Find(TextBox10)
If Not ARA Is Nothing Then
For T = 1 To 10
Sheets("Sayfa1").Cells(ARA.Row, T).Value = Controls("TextBox" & T).Text
Next
Else
MsgBox "Asıl Esas " & TextBox10.Text & " Veri Tabanında Yok...", , "EXCEL.WEB"
End If

düzeltebilriseniz sevinirim..

Değiştir butonu koyarız kolay ama madem başlamışsınız sizin yapmanız açısından for döngüsünde 1 ila 10 arası sayı var çalışmada ilgili textbox numaraları 2 ila 9 8 adet textbox var. artı find fonksiyonundaki textbox10 mevcut çalışmada yok.

For L = 1 To 8
If Controls("TextBox" & L+1).Text = "" Then
MsgBox "LÜTFEN " & Sheets("Sayfa1").Cells(1, L).Value & " GİRİNİZ.", , "EXCEL.WEB.TR"
Exit Sub
End If
Next
Set ARA = Sheets("Sayfa1").Range("A:A").Find(TextBox2)
If Not ARA Is Nothing Then
For T = 1 To 8
Sheets("Sayfa1").Cells(ARA.Row, T).Value = Controls("TextBox" & T+1).Text
Next
Else
MsgBox "Asıl Esas " & TextBox2.Text & " Veri Tabanında Yok...", , "EXCEL.WEB"
End If

en son çalışmada kod böyle olsaydı hata vermiyecekti. bu kodda ise ad kısmına göre arama yaptıgı için ad değiştirilirse ya işlem yapmayacak yada yanlış kayıdı düzelticek.

 

[serhata21]

abicim denedim ama yapanadın hele bi excel saydası yap ben kopya alım

 

[fedeal]

Dosyanız ekte,