Aynı kod ile başlayan veri satırlarını bulma

[beza]

Merhaba,
Sipariş verilerinin bulunduğu "veri" sayfası var. A sütununda sipariş numaraları mevcut. 4 sütun kullanılıyor. Aynı sipariş numarasına ait birden fazla satır var. Bazen 3 satır, bazen 10 satır değişiyor. Yapılmak istenen textbox1 e sipariş numarası yazıldığında o siparişe ait tüm satırları listbox1 e nasıl çekerim?

 

[YUSUF44]

Bunun için örnek dosya paylaşmanız iyi olur. Örnek olarak aşağıdaki kod bloğu Sayfa1'de Sipariş No sütununda bulunan verileri isteğinize göre süzerek listbox1'e aktarır. Ancak muhtemelen sizde tam uyumlu olmayacaktır. Çünkü bu tür kodlar tamamen dosya yapısına göre hazırlanması gereken kodlardır:

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from [Sayfa1$] where [Sipariş No]=" & TextBox1.Text * 1
Set rs = con.Execute(sorgu)

ListBox1.Column = rs.getrows

 

[beza]

Bunun için örnek dosya paylaşmanız iyi olur. Örnek olarak aşağıdaki kod bloğu Sayfa1'de Sipariş No sütununda bulunan verileri isteğinize göre süzerek listbox1'e aktarır. Ancak muhtemelen sizde tam uyumlu olmayacaktır. Çünkü bu tür kodlar tamamen dosya yapısına göre hazırlanması gereken kodlardır:

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from [Sayfa1$] where [Sipariş No]=" & TextBox1.Text * 1
Set rs = con.Execute(sorgu)

ListBox1.Column = rs.getrows

Merhaba Yusuf Bey,
İlgili link aşağıda ekli. Teşekkür ederim.

siparis.xlsm dosyasını indir - download

siparis.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[YUSUF44]

Userformdaki eski kodları silin ve aşağıdaki kodları ekleyin:

Private Sub CommandButton1_Click()
Set s1 = Sheets("Sayfa1")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from [Sayfa1$B:H] where [Sipariş Kodu]=" & TextBox1.Text * 1
Set rs = con.Execute(sorgu)
If Not rs.EOF And Not rs.bof Then
    ListBox1.Column = rs.getrows
Else
    MsgBox TextBox1.Text & " kodlu sipariş bulunmamaktadır!", vbInformation
End If
End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 7
ListBox1.ColumnWidths = "80;80;60;60;80;80;80"
ListBox1ColumnHeads = True

Set s1 = Sheets("Sayfa1")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from [Sayfa1$B:H] where [Sipariş Kodu] is not null"
Set rs = con.Execute(sorgu)

ListBox1.Column = rs.getrows

End Sub

 

[beza]

Userformdaki eski kodları silin ve aşağıdaki kodları ekleyin:

Private Sub CommandButton1_Click()
Set s1 = Sheets("Sayfa1")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from [Sayfa1$B:H] where [Sipariş Kodu]=" & TextBox1.Text * 1
Set rs = con.Execute(sorgu)
If Not rs.EOF And Not rs.bof Then
    ListBox1.Column = rs.getrows
Else
    MsgBox TextBox1.Text & " kodlu sipariş bulunmamaktadır!", vbInformation
End If
End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
End Sub

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 7
ListBox1.ColumnWidths = "80;80;60;60;80;80;80"
ListBox1ColumnHeads = True

Set s1 = Sheets("Sayfa1")
son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "B").End(3).Row)

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from [Sayfa1$B:H] where [Sipariş Kodu] is not null"
Set rs = con.Execute(sorgu)

ListBox1.Column = rs.getrows

End Sub

Harika. Çok teşekkür ederim. Çok Sağ olun.

 

[beza]

Harika. Çok teşekkür ederim. Çok Sağ olun.

ListBox1ColumnHeads içine başlık yazdırmam mümkün olabilir mi?

 

[YUSUF44]

Ben de dün sizin bi konunuzdan öğrenmiştim. O özellik Rowsource ile veri alındığında oluyormuş:

Listbox sütun toplama hatası

Merhaba, Private Sub CommandButton5_Click() 'listbox aktarım ListBox1.AddItem ListBox1.List(ListBox1.ListCount - 1, 0) = TextBox9.Value ListBox1.List(ListBox1.ListCount - 1, 1) = TextBox10.Value ListBox1.List(ListBox1.ListCount - 1, 2) = TextBox11.Value ListBox1.List(ListBox1.ListCount - 1, 3) =...

www.excel.web.tr

 

[beza]

Ben de dün sizin bi konunuzdan öğrenmiştim. O özellik Rowsource ile veri alındığında oluyormuş:

Listbox sütun toplama hatası

Merhaba, Private Sub CommandButton5_Click() 'listbox aktarım ListBox1.AddItem ListBox1.List(ListBox1.ListCount - 1, 0) = TextBox9.Value ListBox1.List(ListBox1.ListCount - 1, 1) = TextBox10.Value ListBox1.List(ListBox1.ListCount - 1, 2) = TextBox11.Value ListBox1.List(ListBox1.ListCount - 1, 3) =...

www.excel.web.tr

Tamamdır. Tekrar çok teşekkür ederim.