Arkadaşlar ekdeki dosyada daha önce forumdan bir arkadaşımızın aşağıdaki kodları ile textbox 20 ve textbox 21 ile süzme yapmaya çalışıyorum fakat hata veriyor.
yardımlarınızı rica ediyorum
Private Sub TextBox20_Change()
'On Error Resume Next
Dim k As Range, a As Long, j As Byte, ilk_adres As String
'ListBox1.Clear
ReDim myarr(1 To 3, 1 To 1)
Set k = Range("B2:B65536").Find(TextBox20.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
ilk_adres = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 3, 1 To a)
For j = 0 To 2
myarr(j + 1, a) = k.Offset(1, j).Value
Next j
Set k = Range("B2:B65536").FindNext(k)
Loop While k.Address <> ilk_adres And Not k Is Nothing
ListBox1.Column = myarr
End If
End Sub
yardımlarınızı rica ediyorum
Private Sub TextBox20_Change()
'On Error Resume Next
Dim k As Range, a As Long, j As Byte, ilk_adres As String
'ListBox1.Clear
ReDim myarr(1 To 3, 1 To 1)
Set k = Range("B2:B65536").Find(TextBox20.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
ilk_adres = k.Address
Do
a = a + 1
ReDim Preserve myarr(1 To 3, 1 To a)
For j = 0 To 2
myarr(j + 1, a) = k.Offset(1, j).Value
Next j
Set k = Range("B2:B65536").FindNext(k)
Loop While k.Address <> ilk_adres And Not k Is Nothing
ListBox1.Column = myarr
End If
End Sub