Arama

[simsek3131]

değerli arkadaşlar ekte sunmuş olduğum dosyada bir arama sonuç sayfası yaptım parametre sayfasında formu aç bütonu tıklandığında açılan pencerede tc kimlik hanesine yazdığınız tc numarasıyla sayfalar arası kaydı arıyor ve arama sonucunu arama sayfasına atıyor buraya kadar bir sorun yok

arama sonucu sadece sayfaların A7 satırındaki kaydı veriyor yani siz hangi tc numarasını girerseniz girin kayıt hangi köyde ise o köye ait sayfanın A 7 satırında hangi kayıt varsa arama sayfasına o kaydı getiriyor
benim istediğim sayfa içerisinde kayıt araması ve doğru kaydı getirmesi

 

[simsek3131]

formda yardım edecek bir arkadaş yokmu acaba

 

[Necdet]

Merhaba,

Ben pek bir hata göremedim, ama verilerinizdeki t.c noları hepsi aynı. Bu durumda sizin dediğiniz şeyin olması doğal değil mi?

Yinede kodlarda küçük bir değişiklik yaptım.

Deneyiniz.

Private Sub ARA_Click()
    Dim i As Byte
    Dim bUl
    Dim var As Boolean
    Dim sAtir As Integer
    
    
    sAtir = Sheets("ARAMA").Cells(Rows.Count, "B").End(xlUp).Row + 1
    var = False
    
    For i = 4 To Sheets.Count
            
        Set bUl = Sheets(i).Range("A:A").Find(TextBox1, LookAt:=xlWhole)
        If Not bUl Is Nothing Then
            
            Sheets("ARAMA").Cells(sAtir, "A") = Sheets(i).[B3]
            Sheets("ARAMA").Cells(sAtir, "B") = Sheets(i).[A7]
            Sheets("ARAMA").Cells(sAtir, "C") = Sheets(i).[B7]
            Sheets("ARAMA").Cells(sAtir, "D") = Sheets(i).[C7]
        
            
            Sheets("ARAMA").Cells(sAtir, "E") = Sheets(i).[D7]
            Sheets("ARAMA").Cells(sAtir, "F") = Sheets(i).[E7]
            Sheets("ARAMA").Cells(sAtir, "G") = Sheets(i).[F7]
            Sheets("ARAMA").Cells(sAtir, "H") = Sheets(i).[G7]
            Sheets("ARAMA").Cells(sAtir, "I") = Sheets(i).[H7]
            Sheets("ARAMA").Cells(sAtir, "J") = Sheets(i).[I7]
            
            sAtir = sAtir + 1
            var = True
        End If
        
    Next
    
      If var Then
        MsgBox TextBox1 & " Tc Nosuna sahip kişiye ait bilgiler arama sayfasına yazıldı"
      Else
        MsgBox TextBox1 & " Tc Nosuna sahip kayıt bulunamadı"
      End If
End Sub

 

[simsek3131]

necdet bey eğer aynı köye birden çok kayıt giripte arama yaparsanız hatayı göreceksiniz sadece 1 sıradaki kaydı veriyor yani A7 satırında hangi kayıt varsa o kaydı veriyor arama sonucunda

 

[simsek3131]

girdiğiniz tc numarası hangi köyde ise o köye ait bilgiyi veriyor yanlız çiftçinin adı soyadı ve ürün bilgilerini vermiyorda o köydeki A7 satırında kim varsa onu veriyor

 

[Necdet]

örnek tabloda bir iki bilgi girip gönderin bakalım.

 

[simsek3131]

necdet bey ekte bir örnek gönderdim örnek ahmetbeyli köyüne bir kaç kayıt yaptım eğer en alttaki veya 2-3 sıradaki t.c. numaralarını girerek arama yaparsanız hatayi göreceksiniz. Ahmetbeyli köyü içinde kimin t.c. sini yazarsanız yazın arama sonucu ilk satırdaki kaydı veriyor

 

[Necdet]

Merhaba,

Formun aşağıdaki kodlarını değiştiriniz.

Private Sub ARA_Click()
    
    Dim i       As Byte
    Dim Bul     As Range
    Dim var     As Boolean
    Dim Satir   As Integer
    
    
    Satir = Sheets("ARAMA").Cells(Rows.Count, "B").End(xlUp).Row + 1
    var = False
    
    For i = 4 To Sheets.Count
        
        Set Bul = Sheets(i).Range("A:A").Find(TextBox1, LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            
            Sheets("ARAMA").Cells(Satir, "A") = Sheets(i).Range("B3")
            Sheets("ARAMA").Cells(Satir, "B") = Sheets(i).Range("A" & Bul.Row)
            Sheets("ARAMA").Cells(Satir, "C") = Sheets(i).Range("B" & Bul.Row)
            Sheets("ARAMA").Cells(Satir, "D") = Sheets(i).Range("C" & Bul.Row)
        
            Sheets("ARAMA").Cells(Satir, "E") = Sheets(i).Cells(Bul.Row, "D")
            Sheets("ARAMA").Cells(Satir, "F") = Sheets(i).Cells(Bul.Row, "E")
            Sheets("ARAMA").Cells(Satir, "G") = Sheets(i).Cells(Bul.Row, "F")
            Sheets("ARAMA").Cells(Satir, "H") = Sheets(i).Cells(Bul.Row, "G")
            Sheets("ARAMA").Cells(Satir, "I") = Sheets(i).Cells(Bul.Row, "H")
            Sheets("ARAMA").Cells(Satir, "J") = Sheets(i).Range("I" & Bul.Row)
            
            Satir = Satir + 1
            var = True
        End If
        
    Next
    
      If var Then
        MsgBox TextBox1 & " Tc Nosuna sahip kişiye ait bilgiler arama sayfasına yazıldı"
      Else
        MsgBox TextBox1 & " Tc Nosuna sahip kayıt bulunamadı"
      End If
End Sub

 

[simsek3131]

necdet bey elinize emeğinize sağlık çok teşekkür ederim

 

[Necdet]

necdet bey elinize emeğinize sağlık çok teşekkür ederim

Güle güle kullanınız.