o2l3m
Altın Üye
- Katılım
- 2 Mart 2005
- Mesajlar
- 156
- Excel Vers. ve Dili
- Microsoft® Excel ® 2016 (16.0.5413.1000) MSO (16.0.5413.1000) 32 bit
- Altın Üyelik Bitiş Tarihi
- 14-10-2026
Textbox ile Listbox da arama yaparken ve kutuyu boşaltırken çok fazla bekliyorum.
Sorun veya sıkıntı nerde olabilir?
Private Sub TextBox5_Change()
Dim k As Range, adrs As String, j As Byte, a As Long, myarr()
ReDim myarr(1 To 3, 1 To 1)
With Worksheets("MALZEME")
Me.ListBox3.RowSource = vbNullString
If .FilterMode Then .ShowAllData
Set k = .Range("A2:A65536").Find(TextBox5.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 3, 1 To a)
For j = 1 To 3
myarr(j, a) = .Cells(k.Row, j).Value
Next j
Set k = .Range("A2:A65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox3.Column = myarr
End If
End With
End Sub
Sorun veya sıkıntı nerde olabilir?
Private Sub TextBox5_Change()
Dim k As Range, adrs As String, j As Byte, a As Long, myarr()
ReDim myarr(1 To 3, 1 To 1)
With Worksheets("MALZEME")
Me.ListBox3.RowSource = vbNullString
If .FilterMode Then .ShowAllData
Set k = .Range("A2:A65536").Find(TextBox5.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adrs = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 3, 1 To a)
For j = 1 To 3
myarr(j, a) = .Cells(k.Row, j).Value
Next j
Set k = .Range("A2:A65536").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adrs
ListBox3.Column = myarr
End If
End With
End Sub