Listbox Sütun Sorunu

Tasarım · Dün 21:40 da

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

md3m1ray · Dün 22:17 da

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 · Dün 22:33 da

ü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.

md3m1ray · Dün 22:39 da

Örnek dosya var mı detaylı bakayim

Tasarım · Dün 22:47 da

dosya var da içerisinde kişisel veri çok ve dosya büyük bir dosya 8 bin adet kayıt var

md3m1ray · Dün 23:16 da

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 · Dün 23:25 da

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..

İndir Kitap1 xlsm

Dosyayı indir Kitap1 xlsm

dosya.co

içersindeki kişisel bilgileri sildim. bir yardımcı olun.

md3m1ray · Dün 23:38 da

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

md3m1ray · Dün 23:59 da

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 · Bugün 00:21

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

Bu kodla da ismi tam girdiğim de herşeyi siliyor.

md3m1ray · Bugün 00:53

büyük Türkçe karakterlerden büyük ihtimal bakayım dönerim

md3m1ray · Bugün 01:36

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

md3m1ray · Bugün 01:37

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