Soru Listboxun ilk satırına veri getirme.

[FERAZ]

Merhaba.
Biraz mantıksız fakat yinede belkide çözüm vardır diye sorayım istedim.
Resimde daha iyi anlaşılıyor.

Kısaca textboxta arama yapıyorum ve listboxa veriler geliyor,benim istediğim ise listboxun ilk satırına koddaki kırmızı yerlerin eklenmesi.
Örneğin listboxtta ilk satırdaki C nin alına 8 gelmeli.

Kısaca başlık gibi düşünülebilir.Label felan istemiyorum baştan yazayım sayın Haluk hocam

Saygılar.
Not kod kırmızıya boyanmamış.

.List(0, 0) = "a"
.List(0, 1) = "b"
.List(0, 2) = "c"

Yukarıdaki kodları ekledim.

http://s7.dosya.tc/server10/9ndgev/Listbox_hizli_arama_dizi_ile.rar.html

Private Sub TextBox1_Change()
 
Dim brr(), say As Long, son As Long, y As Long
   On Error GoTo son
   Application.ScreenUpdating = False

With Me.ListBox1
 
 
   son = Range("A" & Rows.Count).End(3).Row
 
    aa = Range("A1:D" & son).Value
  If Me.TextBox1.Value = "" Then GoTo son

    say = 1
    ReDim Preserve brr(1 To 3, 1 To son)
        For y = 1 To son
            If aa(y, 1) = CDbl(Me.TextBox1.Value) Then  'Hizli icin
           
                brr(1, say) = aa(y, 2)
                brr(2, say) = aa(y, 3)
                brr(3, say) = Format(aa(y, 4), "##,0.00")
                say = say + 1
            End If
        Next
         ReDim Preserve brr(1 To 3, 1 To say - 1) 'burasi olmazsa listboxtta bosluk cikar altta
        .Column = brr

        .List(0, 0) = "a"
        .List(0, 1) = "b"
        .List(0, 2) = "c"

    Application.ScreenUpdating = True
    Me.Label1.Caption = say & " Adet Var..."
    Me.Label1.Visible = True
    Erase aa: Erase brr
    Exit Sub
son:
  .Clear
   Application.ScreenUpdating = True
    Erase aa: Erase brr
     Me.Label1.Visible = False
End With
 
End Sub

 

[FERAZ]

Neyse çözümü buldum.Belki birilerine lazım olur,malum listboxtta başlık sorun.

http://s7.dosya.tc/server10/dabk3p/Listbox_hizli_arama_dizi_ile.rar.html

Private Sub TextBox1_Change()
  
 Dim brr(), say As Long, son As Long, y As Long
   On Error GoTo son
   Application.ScreenUpdating = False

With Me.ListBox1
   .Clear
    son = Range("A" & Rows.Count).End(3).Row
  
    aa = Range("A1:D" & son).Value
  If Me.TextBox1.Value = "" Then GoTo son

    say = 1
    ReDim Preserve brr(1 To 3, 1 To son)
    
        For y = 1 To son
            If aa(y, 1) = CDbl(Me.TextBox1.Value) Then  'Hizli icin
                brr(1, say + 1) = aa(y, 2)
                brr(2, say + 1) = aa(y, 3)
                brr(3, say + 1) = Format(aa(y, 4), "##,0.00")
                say = say + 1
            End If
        Next
        
          If say > 1 Then 'Baslik icin
                brr(1, 1) = "A"
                brr(2, 1) = "B"
                brr(3, 1) = "C"
           Else
                GoTo son
          End If
         ReDim Preserve brr(1 To 3, 1 To say)  'burasi olmazsa listboxtta bosluk cikar altta
        .Column = brr

    Application.ScreenUpdating = True
    Me.Label1.Caption = say & " Adet Var..."
    Me.Label1.Visible = True
    Erase aa: Erase brr
    Exit Sub
son:
  .Clear
   Application.ScreenUpdating = True
    Erase aa: Erase brr
     Me.Label1.Visible = False
End With
  
End Sub