Arama Butonu

[ocamurlu]

Merhabalar
Menü sayfasındaki arama butonuna adı soyadı , T.C. , Birimi ve ünvanı yazdığım zaman personel listesindeki verileri çekemiyorum yardımlarınız için şimdiden teşekkür ederim...

 

[ÖmerFaruk]

Kullandığınız kodlarla gönderdiğiniz dosya sanki birbirinden farklı.

    For Each syf In Worksheets
        ad = syf.Name
        If Right(ad, 6) <> "sınıfı" And Right(ad, 5) <> "sınıf" Then GoTo 1

Eğer dosyanız bu ise kodların tamamen değişmesi gerekiyor.
Karar verin lütfen.

 

[ocamurlu]

Kullandığınız kodlarla gönderdiğiniz dosya sanki birbirinden farklı.

    For Each syf In Worksheets
        ad = syf.Name
        If Right(ad, 6) <> "sınıfı" And Right(ad, 5) <> "sınıf" Then GoTo 1

Eğer dosyanız bu ise kodların tamamen değişmesi gerekiyor.
Karar verin lütfen.

Hocam ozaman komple degistirebilirmiyiz size zahmet olmazsa

 

[ÖmerFaruk]

Aramayı nasıl yapmak ve hangi sonuçları lidtelemek istediğiniz anlatabilirsen yapalım.

 

[ocamurlu]

örnek olarak Birime tıklayıp çalıştığı birimini arama kısmına yazınca o birimde çalışanlar gelsin istiyorum..
Ünvan , Adı Soyadı , T.C. olanlarda aynı şekilde

 

[ÖmerFaruk]

Arama kısmına MU yazınca,
Mustafa - Murat - Muhlis vb hepsi gelecek mi?
Bunlar gelecekse KaMUran da gelecek mi?

 

[ÖmerFaruk]

Kısmen değil tam olarak yazdığınız gibi arayacaksa KOD aşağıdadır.

Sub AraYeni()
Dim Sh As Worksheet, Liste()
    Set Sh = Worksheets("MENÜ")
    Ara = Sayfa1.TextBox2
    If Sayfa1.OptionButton1 Then Bak = 2: GoTo 1
    If Sayfa1.OptionButton2 Then Bak = 3: GoTo 1
    If Sayfa1.OptionButton3 Then Bak = 5: GoTo 1
    Bak = 4
1:
    Son = Worksheets("Personel Listesi").Range("C" & Rows.Count).End(3).Row
    If Son < 4 Then Exit Sub
    Veri = Worksheets("Personel Listesi").Range("C4").Resize(Son - 4, 7).Value
    'ReDim Liste(1 To UBound(Veri), 1 To 7)
    
    For i = 1 To UBound(Veri)
        If Veri(i, Bak) = Ara Then
            Say = Say + 1
            ReDim Preserve Liste(1 To 6, 1 To Say)
            For k = 2 To 7
                Liste(k - 1, Say) = Veri(i, k)
            Next k
        End If
    Next i
    If Say > 0 Then
        Son = Sayfa1.Range("D" & Rows.Count).End(3).Row
        If Son < 9 Then Son = 9
        Sayfa1.Range("E9:L" & Son).ClearContents
        Sayfa1.Range("E9").Resize(UBound(Liste, 2), UBound(Liste, 1)) = Application.Transpose(Liste)
        Mesaj = "Bulunan " & Say & " kayıt listelenmiştir"
    Else
        Mesaj = "Aramaya uygun kayıt bulunamamıştır"
    End If
    MsgBox Mesaj, vbOKOnly
End Sub

 

[ocamurlu]

Kısmen değil tam olarak yazdığınız gibi arayacaksa KOD aşağıdadır.

Sub AraYeni()
Dim Sh As Worksheet, Liste()
    Set Sh = Worksheets("MENÜ")
    Ara = Sayfa1.TextBox2
    If Sayfa1.OptionButton1 Then Bak = 2: GoTo 1
    If Sayfa1.OptionButton2 Then Bak = 3: GoTo 1
    If Sayfa1.OptionButton3 Then Bak = 5: GoTo 1
    Bak = 4
1:
    Son = Worksheets("Personel Listesi").Range("C" & Rows.Count).End(3).Row
    If Son < 4 Then Exit Sub
    Veri = Worksheets("Personel Listesi").Range("C4").Resize(Son - 4, 7).Value
    'ReDim Liste(1 To UBound(Veri), 1 To 7)
   
    For i = 1 To UBound(Veri)
        If Veri(i, Bak) = Ara Then
            Say = Say + 1
            ReDim Preserve Liste(1 To 6, 1 To Say)
            For k = 2 To 7
                Liste(k - 1, Say) = Veri(i, k)
            Next k
        End If
    Next i
    If Say > 0 Then
        Son = Sayfa1.Range("D" & Rows.Count).End(3).Row
        If Son < 9 Then Son = 9
        Sayfa1.Range("E9:L" & Son).ClearContents
        Sayfa1.Range("E9").Resize(UBound(Liste, 2), UBound(Liste, 1)) = Application.Transpose(Liste)
        Mesaj = "Bulunan " & Say & " kayıt listelenmiştir"
    Else
        Mesaj = "Aramaya uygun kayıt bulunamamıştır"
    End If
    MsgBox Mesaj, vbOKOnly
End Sub

Sorun çözüldü teşekkürler