sayfadaki bilgilere göre textbox tan sorgulama ve ........

Katılım
7 Mart 2005
Mesajlar
91
Excel Vers. ve Dili
2003 / 2010
Kolay gelsin dileklerimle sorunumu aktarmak istiyorum
Form üzerinde ADI SOYADI veya PLAKASI için sorgulama yapmak üzere 2 adet textbox var
herhangi birine bilgi girip sorgula butonuna veya Enter tuşuna bastığım zaman sorgulanan bilgi AD SOYAD için I sütünundan Plakası için M sütünundan
alacak eğer doğru ise Listbox'a getirecek yoksa aranan kayıt bulunamadı şeklinde uyarı verecek ve listbox taki bilgi üzerine enter tuşuyla bastığım zaman sayfa üzerindeki ilgili satıra gidecek
yardımlarınız için şimdiden teşekkür ederim.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Sorgula butonuna aşağıdaki kodu yazın.

[vb:1:4550d7906a]Private Sub CommandButton1_Click()
ListBox1.Clear
ListBox1.ColumnCount = 12
ListBox1.ColumnWidths = "150;50"
On Error GoTo 10
If TextBox1 <> "" Then sat = [i1:i65536].Find(TextBox1.Value).Row
If TextBox2 <> "" Then sat = [m1:m65536].Find(TextBox2.Value).Row
ListBox1.AddItem
ListBox1.List(0, 0) = Cells(sat, 9).Value
ListBox1.List(0, 1) = Cells(sat, 13).Value
Exit Sub
10 MsgBox "ARANAN VERİ BULUNAMADI"
End Sub[/vb:1:4550d7906a]

Kod içindeki aşağıdaki satırlar commandbuttondan silinip userForm_Initialize olayınada yazılabilir.

[vb:1:4550d7906a]ListBox1.ColumnCount = 12
ListBox1.ColumnWidths = "150;50"
[/vb:1:4550d7906a]
 
Katılım
7 Mart 2005
Mesajlar
91
Excel Vers. ve Dili
2003 / 2010
kodlar için şükranlarımı arz ederim
fakat bir sorum daha olacak.
listbox içerisine gelen kaydı seçip sayfa üzerinde ilgili satıra gitmenin bir yolu varmı acaba?
saygılar teşekkürler.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Tüm kodların en başına aşağıdakği satırı yerleştirin. Böylece sat değişkenini aynı modüldeki tüm kodlar içinde yeniden tanımlamaya gerek kalmadan kullanabilirsiniz.

[vb:1:925a1245b9]Dim sat As Integer
[/vb:1:925a1245b9]

Listboxada aşağıdaki kodu yazın.

[vb:1:925a1245b9]Private Sub ListBox1_Click()
Cells(sat, 1).Select
End Sub
[/vb:1:925a1245b9]
 
Katılım
7 Mart 2005
Mesajlar
91
Excel Vers. ve Dili
2003 / 2010
herşey için teşekkürler elinize sağlık
fakat bir sorun daha var
tek bir isim var 2 tane plaka var ise isme göre sorgulandığında plakanın birini gösteriyor aynı isim altında kaç tane plaka var ise tümünü listelemesini istiyorum (veya tam tersi durumunda 2 isim de tek palaka var ise)
kolay gelsin
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Kodu aşağıdaki ile değiştirerek deneyin.

[vb:1:6d8ab1011b]Private Sub CommandButton1_Click()
ListBox1.Clear
ListBox1.ColumnCount = 12
ListBox1.ColumnWidths = "150;50"
On Error GoTo 10
If TextBox1 <> "" Then
c = 1
d = 9
End If
If TextBox2 <> "" Then
c = 2
d = 13
End If
For a = 2 To [a65536].End(xlUp).Row
If Cells(a, d) = Controls("textbox" & c) Then
f = f + 1
ListBox1.AddItem
ListBox1.List(f - 1, 0) = Cells(a, 9).Value
ListBox1.List(f - 1, 1) = Cells(a, 13).Value
End If
Next
Exit Sub
10 MsgBox "ARANAN VERİ BULUNAMADI"
End Sub[/vb:1:6d8ab1011b]
 
Katılım
7 Mart 2005
Mesajlar
91
Excel Vers. ve Dili
2003 / 2010
yuardaki kodları ekledim şimdi sorgulama tam yapıyor ama bu kez listede olmayan isim veya plakayı sorgula dediğim zaman uyarı mesajı gelmiyor çalışmayı ekledim incelerseniz iyi olur
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki şekilde deneyin.

[vb:1:e5d206101a]Private Sub CommandButton6_Click()
ListBox2.Clear
ListBox2.ColumnCount = 3
ListBox2.ColumnWidths = ""
If TextBox1 <> "" Then
c = 1
d = 9
End If
If TextBox2 <> "" Then
c = 2
d = 13
End If
For a = 2 To [a65536].End(xlUp).Row
If Cells(a, d) = Controls("textbox" & c) Then
f = f + 1
ListBox2.AddItem
ListBox2.List(f - 1, 0) = Cells(a, 1).Value
ListBox2.List(f - 1, 1) = Cells(a, 9).Value
ListBox2.List(f - 1, 2) = Cells(a, 13).Value
End If
Next
If f = 0 Then MsgBox "İSİM VE PLAKAYA AİT BİLGİLERE RASTLANMADI !"
End Sub[/vb:1:e5d206101a]
 
Katılım
7 Mart 2005
Mesajlar
91
Excel Vers. ve Dili
2003 / 2010
If Cells(a, d) = Controls("textbox" & c) Then
affınıza sığınarak bir şey daha sormak istiyorum
yanlışlıkla textboxlar boş olarak sorgula dediğimde VBA kod sayfasında yukarıdaki hatayı veriyor
sonuçta sorgulama için bir bilgi gerek ama resetlemedikçede işlem yapmaya izin vermiyor
bunun dışında herşey tamam çalışmanın tümünü eklemek isterdim ama 1 mb yakın
ilginiz ve verdiğiniz emek için teşekkürler
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Bu durumda kodun en üstüne aşağıdaki satırı ekleyin.

if textbox1="" and textbox2="" then exit sub
 
Katılım
7 Mart 2005
Mesajlar
91
Excel Vers. ve Dili
2003 / 2010
sorgulama ilgili başka bir çalışmada şöyle bir sorum var
textbox1 e bir isim girdiğim zaman sayfa1'den B2 ile G1500 aralığından herhangi bir ismi sorgulamak istiyorum
ve bu ismin listbox1 de hangi kayıt numarasında yer aldığını belirtmesini yoksa böyle bir kayıt yok şeklinde uyarı vermesi
ben ekteki örnekte yapmaya çalıştım ama başarılı olamadım
yardımcı olursanız memnun olurum.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki kodları ilgili nesnelere yazarak deneyin.

[vb:1:c552467e44]Private Sub CommandButton1_Click()
On Error GoTo 10
sat = Sheets("sayfa1").[a2:g1500].Find(TextBox1.Value).Row - 1
ListBox1.ListIndex = sat - 1
MsgBox sat & " nolu kayıtta bulunmuştur."
Exit Sub
10 If ListBox1.ListIndex > -1 Then ListBox1.Selected(ListBox1.ListIndex) = False
MsgBox "aranan veri bulunamadı"
End Sub

Private Sub UserForm_Initialize()
ListBox1.ColumnHeads = False
ListBox1.ColumnCount = 7
ListBox1.RowSource = "sayfa1!a2:g1500"
End Sub[/vb:1:c552467e44]
 
Üst