listbox-combobox yardım

[bitmez13]

yardım ederseniz sevinirim

 

[Ferhat Pazarçevirdi]

Kodlarınızdaki ilgili yerleri; aşağıdaki gibi revize ediniz.

Private Sub ComboBox1_Change()
On Error Resume Next
Sheets(ComboBox1.Text).Select
TextBox4.Text = ""
If Sheets(ComboBox1.Text).Cells(65536, 1).End(xlUp).Row > 1 Then
   With ListBox1
       .ColumnCount = 3
       .ColumnWidths = "20;20;20"
       .List = Sheets(ComboBox1.Text).Range("A2:C" & Sheets(ComboBox1.Text).Cells(65536, 1).End(xlUp).Row).Value
   End With
Else
ListBox1.Clear
End If
End Sub
'----------------------------------------------------------------
 
Private Sub TextBox4_Change()
Dim sh As Worksheet
Dim bul As Range
Dim y%, j%, sat%, x%
Dim arr(), satir()
Dim adres As String
If Trim(ComboBox1) = Empty Then: Exit Sub
Set sh = Sheets(ComboBox1.Text)
Set bul = sh.Range("A2:C65536").Find(TextBox4)
ListBox1.Clear
If Not bul Is Nothing Then
   adres = bul.Address
   Do
     On Error Resume Next
     For j = 1 To UBound(satir)
         If Err.Number > 0 Then: Err.Number = 0: Exit For
         If bul.Row = satir(j) Then: GoTo f1
     Next
     If bul.Row = sat Or bul.Row = 1 Then: GoTo f1
        y = y + 1
        ReDim Preserve arr(1 To 3, 1 To y)
        arr(1, y) = sh.Cells(bul.Row, 1)
        arr(2, y) = sh.Cells(bul.Row, 2)
        arr(3, y) = sh.Cells(bul.Row, 3)
        If y = 1 Then
           ReDim Preserve satir(1 To 1)
           satir(1) = bul.Row
        Else
           For j = 1 To UBound(satir)
               If satir(j) = bul.Row Then x = x + 1
           Next
           If x = 0 Then
              ReDim Preserve satir(UBound(satir) + 1)
              satir(UBound(satir) + 1) = bul.Row
           End If
        End If
        sat = bul.Row
f1:
        Set bul = sh.Range("A2:C65536").FindNext(bul)
   Loop While Not bul Is Nothing And bul.Address <> adres
   ListBox1.List = Application.WorksheetFunction.Transpose(arr)
   Erase arr
Else
ListBox1.Clear
End If
Set bul = Nothing
Set sh = Nothing
End Sub