Çözüldü Listbox Sütun Sorunu

Tasarım

Tasarım

Altın Üye
Katılım
3 Şubat 2005
Mesajlar
289
Excel Vers. ve Dili
Microsoft Excel 2013 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
16-11-2025
Arkadaşlar merhaba, aşağıdaki kodlarda Listbox1 içerisinde arama yapabiliyorum fakat bulduğum veri sadece bir sütunda gösteriyor. Benim 7 sütunlu verim var ve ben seçtiğim bilginin 7 sütunda gösterilmesini istiyorum. Bunu bir türlü yapamadım. Lütfen yardımcı olur musunuz?

Kod: 
Private Sub TextBox1_Change()
ListBox1.RowSource = Empty
ListBox1.Clear
For Each isim In Range("a2:a" & Range("A65536").End(xlUp).Row)
    If UCase(LCase(isim)) Like UCase(LCase(TextBox1)) & "*" Then
        liste = ListBox1.ListCount
            ListBox1.AddItem
            ListBox1.List(liste, 0) = isim
                       
     End If
Next
End Sub
 
Son düzenleme:
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
merhaba bu şekilde uyarlayıp dener misiniz :

Kod: 
Dim S1 As Worksheet
Set S1 = ThisWorkbook.Sheets("Sayfa1")

''''''kodlarınız

Private Sub TextBox1_Change()
ListBox1.RowSource = Empty
ListBox1.Clear
For Each isim In Range("a2:a" & Range("A65536").End(xlUp).Row)

If UCase(LCase(isim)) Like UCase(LCase(TextBox1)) & "*" Then
liste = ListBox1.ListCount
With Me.ListBox1
.AddItem S1.Cells(liste, 0).Value
            .List(liste, 1) = S1.Cells(liste, 1).Value
            .List(liste, 2) = S1.Cells(liste, 2).Value
            .List(liste, 3) = S1.Cells(liste, 3).Value
            .List(liste, 4) = S1.Cells(liste, 4).Value
            .List(liste, 5) = S1.Cells(liste, 5).Value
            .List(liste, 6) = S1.Cells(liste, 6).Value
            End With
end if
Next
End Sub
 
Tasarım

Tasarım

Altın Üye
Katılım
3 Şubat 2005
Mesajlar
289
Excel Vers. ve Dili
Microsoft Excel 2013 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
16-11-2025
üstadım yardım için teşekkür ederim ancak çalışmadı. textboxu çalıştırdığımda hiç bir veri bulamıyor. listbox boş kalıyor.
 
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
Örnek dosya var mı detaylı bakayim
 
Tasarım

Tasarım

Altın Üye
Katılım
3 Şubat 2005
Mesajlar
289
Excel Vers. ve Dili
Microsoft Excel 2013 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
16-11-2025
dosya var da içerisinde kişisel veri çok ve dosya büyük bir dosya 8 bin adet kayıt var
 
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
benzerini 2 3 satır olacak şekilde yazın boş bir excele sadece veri tablonuzun sütun ve satırlarını nasıl oluşturduğunuz onemli veriler a2 b2 c2 d2 e2 f2 g2 sütunlarında mı vb..
 
Tasarım

Tasarım

Altın Üye
Katılım
3 Şubat 2005
Mesajlar
289
Excel Vers. ve Dili
Microsoft Excel 2013 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
16-11-2025
md3m1ray' Alıntı:
benzerini 2 3 satır olacak şekilde yazın boş bir excele sadece veri tablonuzun sütun ve satırlarını nasıl oluşturduğunuz onemli veriler a2 b2 c2 d2 e2 f2 g2 sütunlarında mı vb..
Genişletmek için tıkla ...

İndir Kitap1

Dosyayı indir Kitap1
dosya.co
içersindeki kişisel bilgileri sildim. bir yardımcı olun.
 
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
bunu dener misiniz

Kod: 
Private Sub TextBox1_Change()
On Error Resume Next
If Me.TextBox1.Text = "" Then
Me.ListBox1.Clear
    Call UserForm_Initialize
    Exit Sub
    End If

        Set S1 = ThisWorkbook.Sheets("Sayfa1")
        ListBox1.RowSource = Empty
        Me.ListBox1.Clear
        Dim r, last_row As Integer
        last_row = S1.Range("A65536").End(xlUp).Row
        For r = 2 To last_row
        a = Len(Me.TextBox1.Text)
        If UCase(Left(S1.Cells(r, "B").Value, a)) = UCase(Me.TextBox1.Text) Then
            With Me.ListBox1

            .AddItem S1.Cells(r, "A").Value
            .List(.ListCount - 1, 1) = S1.Cells(r, "B").Value
            .List(.ListCount - 1, 2) = S1.Cells(r, "C").Value
            .List(.ListCount - 1, 3) = S1.Cells(r, "D").Value
            .List(.ListCount - 1, 4) = S1.Cells(r, "E").Value
            .List(.ListCount - 1, 5) = S1.Cells(r, "F").Value
            .List(.ListCount - 1, 6) = S1.Cells(r, "G").Value
                       
            End With
        End If
        Next r

End Sub
 
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
bu şekilde bir tane ComboBoxAra isimli combobox oluşturarak kritere göre arama da yapabilirsiniz

Kod: 
Dim kriter

Private Sub ComboBoxAra_Change()
Set S1 = ThisWorkbook.Sheets("Sayfa1")
Dim c As Integer
Dim column_headers
column_headers = Array("A", "B", "C", "D", "E", "F", "G")

For c = 1 To 7
If S1.Cells(1, c).Value = Me.ComboBoxAra.Value Then
kriter = column_headers(c - 1)
End If
Next

Me.TextBox1.Value = ""
Me.TextBox1.SetFocus

End Sub


Private Sub TextBox1_Change()
On Error Resume Next
If Me.TextBox1.Text = "" Then
Me.ListBox1.Clear

    Call UserForm_Initialize
    Exit Sub
    End If
If Me.ComboBoxAra.Value <> "" Then
        Set S1 = ThisWorkbook.Sheets("Sayfa1")
        ListBox1.RowSource = Empty
        Me.ListBox1.Clear
        Dim r, last_row As Integer
        last_row = S1.Range("A65536").End(xlUp).Row
        For r = 2 To last_row
        a = Len(Me.TextBox1.Text)
        If UCase(Left(S1.Cells(r, kriter).Value, a)) = UCase(Me.TextBox1.Text) Then
            With Me.ListBox1

            .AddItem S1.Cells(r, "A").Value
            .List(.ListCount - 1, 1) = S1.Cells(r, "B").Value
            .List(.ListCount - 1, 2) = S1.Cells(r, "C").Value
            .List(.ListCount - 1, 3) = S1.Cells(r, "D").Value
            .List(.ListCount - 1, 4) = S1.Cells(r, "E").Value
            .List(.ListCount - 1, 5) = S1.Cells(r, "F").Value
            .List(.ListCount - 1, 6) = S1.Cells(r, "G").Value
                      
            End With
        End If
        Next r
 End If
End Sub

Private Sub UserForm_Activate()
Set S1 = ThisWorkbook.Sheets("Sayfa1")
    With Me.ComboBoxAra
.AddItem S1.Cells(1, 1).Value
.AddItem S1.Cells(1, 2).Value
.AddItem S1.Cells(1, 3).Value
.AddItem S1.Cells(1, 4).Value
.AddItem S1.Cells(1, 5).Value
.AddItem S1.Cells(1, 6).Value
.AddItem S1.Cells(1, 7).Value
End With
End Sub

Private Sub UserForm_Initialize()

   For i = 2 To Range("A65536").End(3).Row
        With ListBox1
            .ColumnCount = 7
            .AddItem Cells(i, 1)
            .List(.ListCount - 1, 1) = Cells(i, 2)
            .List(.ListCount - 1, 2) = Cells(i, 3)
            .List(.ListCount - 1, 3) = Cells(i, 4)
            .List(.ListCount - 1, 4) = Cells(i, 5)
            .List(.ListCount - 1, 5) = Cells(i, 6)
            .List(.ListCount - 1, 6) = Cells(i, 7)
            .List(.ListCount - 1, 7) = Cells(i, 8)
            
        End With
    Next i
    
    sütun = Cells(1, Columns.Count).End(1).Column
    For a = 1 To sütun
        s = s & CLng(Columns(a).Width) & ";"
    Next
    ListBox1.ColumnWidths = s
    
End Sub
 
Tasarım

Tasarım

Altın Üye
Katılım
3 Şubat 2005
Mesajlar
289
Excel Vers. ve Dili
Microsoft Excel 2013 32Bit Türkçe
Altın Üyelik Bitiş Tarihi
16-11-2025
md3m1ray' Alıntı:
bunu dener misiniz

Kod: 
Private Sub TextBox1_Change()
On Error Resume Next
If Me.TextBox1.Text = "" Then
Me.ListBox1.Clear
    Call UserForm_Initialize
    Exit Sub
    End If

        Set S1 = ThisWorkbook.Sheets("Sayfa1")
        ListBox1.RowSource = Empty
        Me.ListBox1.Clear
        Dim r, last_row As Integer
        last_row = S1.Range("A65536").End(xlUp).Row
        For r = 2 To last_row
        a = Len(Me.TextBox1.Text)
        If UCase(Left(S1.Cells(r, "B").Value, a)) = UCase(Me.TextBox1.Text) Then
            With Me.ListBox1

            .AddItem S1.Cells(r, "A").Value
            .List(.ListCount - 1, 1) = S1.Cells(r, "B").Value
            .List(.ListCount - 1, 2) = S1.Cells(r, "C").Value
            .List(.ListCount - 1, 3) = S1.Cells(r, "D").Value
            .List(.ListCount - 1, 4) = S1.Cells(r, "E").Value
            .List(.ListCount - 1, 5) = S1.Cells(r, "F").Value
            .List(.ListCount - 1, 6) = S1.Cells(r, "G").Value
                      
            End With
        End If
        Next r

End Sub
Genişletmek için tıkla ...
Bu kodla da ismi tam girdiğim de herşeyi siliyor.
 
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
büyük Türkçe karakterlerden büyük ihtimal bakayım dönerim
 
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
bu combobox lı versiyon

Kod: 
Dim kriter

Private Sub ComboBoxAra_Change()
Set S1 = ThisWorkbook.Sheets("Sayfa1")
Dim c As Integer
Dim column_headers
column_headers = Array("A", "B", "C", "D", "E", "F", "G")

For c = 1 To 7
If S1.Cells(1, c).Value = Me.ComboBoxAra.Value Then
kriter = column_headers(c - 1)
End If
Next

Me.TextBox1.Value = ""
Me.TextBox1.SetFocus

End Sub
Function upper_i(myStr As String) As String
    upper_i = UCase$(myStr)
    upper_i = Replace(upper_i, ChrW(304), "I")
End Function

Private Sub TextBox1_Change()
On Error Resume Next
If Me.TextBox1.Text = "" Then
Me.ListBox1.Clear

    Call UserForm_Initialize
    Exit Sub
    End If
    
If Me.ComboBoxAra.Value <> "" Then
        Set S1 = ThisWorkbook.Sheets("Sayfa1")
        ListBox1.RowSource = Empty
        Me.ListBox1.Clear
        Dim r, last_row As Integer
        last_row = S1.Range("A65536").End(xlUp).Row
        For r = 2 To last_row
        a = Len(Me.TextBox1.Text)
        If InStr(1, Left(upper_i(S1.Cells(r, kriter).Value), a), upper_i(Me.TextBox1.Text), vbTextCompare) Then
            With Me.ListBox1

            .AddItem S1.Cells(r, "A").Value
            .List(.ListCount - 1, 1) = S1.Cells(r, "B").Value
            .List(.ListCount - 1, 2) = S1.Cells(r, "C").Value
            .List(.ListCount - 1, 3) = S1.Cells(r, "D").Value
            .List(.ListCount - 1, 4) = S1.Cells(r, "E").Value
            .List(.ListCount - 1, 5) = S1.Cells(r, "F").Value
            .List(.ListCount - 1, 6) = S1.Cells(r, "G").Value
                      
            End With
        End If
        Next r
 End If
End Sub

Private Sub UserForm_Activate()
Set S1 = ThisWorkbook.Sheets("Sayfa1")
    With Me.ComboBoxAra
.AddItem S1.Cells(1, 1).Value
.AddItem S1.Cells(1, 2).Value
.AddItem S1.Cells(1, 3).Value
.AddItem S1.Cells(1, 4).Value
.AddItem S1.Cells(1, 5).Value
.AddItem S1.Cells(1, 6).Value
.AddItem S1.Cells(1, 7).Value
End With
End Sub
 
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
combobox sız

Kod: 
Function upper_i(myStr As String) As String
    upper_i = UCase$(myStr)
    upper_i = Replace(upper_i, ChrW(304), "I")
End Function

Private Sub TextBox1_Change()
On Error Resume Next
If Me.TextBox1.Text = "" Then
Me.ListBox1.Clear

    Call UserForm_Initialize
    Exit Sub
    End If
    
        Set S1 = ThisWorkbook.Sheets("Sayfa1")
        ListBox1.RowSource = Empty
        Me.ListBox1.Clear
        Dim r, last_row As Integer
        last_row = S1.Range("A65536").End(xlUp).Row
        For r = 2 To last_row
        a = Len(Me.TextBox1.Text)
        If InStr(1, Left(upper_i(S1.Cells(r, kriter).Value), a), upper_i(Me.TextBox1.Text), vbTextCompare) Then
            With Me.ListBox1

            .AddItem S1.Cells(r, "A").Value
            .List(.ListCount - 1, 1) = S1.Cells(r, "B").Value
            .List(.ListCount - 1, 2) = S1.Cells(r, "C").Value
            .List(.ListCount - 1, 3) = S1.Cells(r, "D").Value
            .List(.ListCount - 1, 4) = S1.Cells(r, "E").Value
            .List(.ListCount - 1, 5) = S1.Cells(r, "F").Value
            .List(.ListCount - 1, 6) = S1.Cells(r, "G").Value
                      
            End With
        End If
        Next r
End Sub
 
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
Yeni konu açmışsıniz bu işinizi görmedi mi
 
M

md3m1ray

Altın Üye
Katılım
21 Şubat 2024
Mesajlar
167
Excel Vers. ve Dili
Excel 2021-tr-64 bit
Altın Üyelik Bitiş Tarihi
23-10-2025
Anladım ben testini yaptım sıkıntısız çalışıyor arama ve bulduğunu listeleme.. kodlariniza uyarlamada mi sıkıntı yaşadınız acaba anlamadım
 
P

pitchoute

Katılım
11 Temmuz 2024
Mesajlar
208
Excel Vers. ve Dili
Excel 2021 Türkçe
Merhaba, şu şekilde deneyip sonucu paylaşabilir misiniz;

Kod: 
Private Sub TextBox1_Change()
    Dim liste As Long
    Dim isim As Range
    Dim i As Integer
    ListBox1.ColumnCount = 7
    ListBox1.RowSource = vbNullString
    ListBox1.Clear
    For Each isim In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        If UCase(isim.Value) Like UCase(TextBox1.Text) & "*" Then
            liste = ListBox1.ListCount
            ListBox1.AddItem
            For i = 1 To 7
                ListBox1.List(liste, i - 1) = isim.Offset(0, i - 1).Value
            Next i
        End If
    Next isim
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst