DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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.
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
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
Private Sub TextBox9_Enter()
TextBox9 = ""
End Sub