• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Bul Makrosunda Yardım

  • Konbuyu başlatan Konbuyu başlatan fatih34
  • Başlangıç tarihi Başlangıç tarihi
Katılım
2 Ekim 2007
Mesajlar
359
Excel Vers. ve Dili
2010
Tüm forum üyelerine iyi hafta sonları dilerim. Formda gördüğüm bir örnek çalışmayı kendi çalışmama uyguladım.
Bul makrosun da takıldım kaldım. Bu konuda bir yardım ederseniz sevinirim.
 

Ekli dosyalar

Listboxa additem yöntemi ile en fazla 10 sütuna kadar veri yükleyebilirsiniz. Gizli bir sayfa oluşturun. Arama sonucu bulunan kayıtları bu sayfaya aktardıktan sonra listboxa rowsource metodu ile yükleyin.
 
Listboxa additem yöntemi ile en fazla 10 sütuna kadar veri yükleyebilirsiniz. Gizli bir sayfa oluşturun. Arama sonucu bulunan kayıtları bu sayfaya aktardıktan sonra listboxa rowsource metodu ile yükleyin.

Levent Hocam Teşekkür ederim.Ancak hocam acemi olduğum için dediğiniz nasıl yapacam.
 
Sayın Evren Gizlen Sayesinde öğrendiklerimi aktarıyorum:

Buton Nesnesinin Click olayına aşağıda ki kodları yazınız:
Kod:
Private Sub cmdBUL_Click()
'--Bu kodlar Sayın Evren Gizlen den alıntı dır.
'--Tüm arama çalışmalarımda başvuru kaynağı olarak kullanmaktayım.
'-- Kendisine bir kez daha teşekkürlerimi iletiyorum.
'
Dim kss As Integer
Worksheets("Sayfa1").Select
Selection.Activate
kss = Worksheets("Sayfa1").[B65536].End(xlUp).Row

Dim k As Range, adrs As String, j As Byte, a As Long
ReDim myarr(1 To 10, 1 To 1)
If TextBox9.Text = "" Then
TextBox9.Text = "Aranacak Kişi"
ListBox1.RowSource = "Sayfa1!A2:O" & kss
Exit Sub
End If
With Worksheets("Sayfa1")
    ListBox1.RowSource = ""
    If .FilterMode Then .ShowAllData
    Set k = .Range("E2:E" & kss).Find(TextBox9.Text & "*", , xlValues, xlPart)
    ReDim Preserve myarr(1 To 10, 1 To kss)
If Not k Is Nothing Then
    adrs = k.Address
    Do
        a = a + 1
            For j = 1 To 10
                myarr(j, a) = .Cells(k.Row, j).Value
            Next j
        Set k = Range("E2:E" & kss).FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adrs
    If a > 0 Then
        ReDim Preserve myarr(1 To 10, 1 To a)
        ListBox1.Column = myarr
    End If
End If
End With
MsgBox ListBox1.ListCount & " adet kayıt bulundu!", vbOKOnly + vbCritical, "ARAMA SONUCU:"


End Sub

TextBox9 Nesnesinin Exit(Çıkış) Olayına aşağıda ki kodları yazınız:
Kod:
Private Sub TextBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim kss As Integer
kss = Worksheets("Sayfa1").[B65536].End(xlUp).Row

    If TextBox9 = "" Then
        ListBox1.RowSource = "Sayfa1!A2:O" & kss
        TextBox9.Text = "Aranacak kişiyi adı ile"
    End If
End Sub

TextBox9 Nesnesinin Enter(Giriş) olayına aşağıda ki kodları yazınız:
Kod:
Private Sub TextBox9_Enter()
    TextBox9 = ""
End Sub
 
Teşekkür ederim sayın hocam, siz değerli hocalarım sayesinde bizlerde bir şeyler yapmaya çalışıyoruz
 
Geri
Üst