listboxa uyarlama

[Cengizhantr06]

merhaba bu kodlardaki listview yerine listboxa çevirebilirmiyiz acaba

Sub gir_tarihara()
Dim sr As Worksheet
Dim X As Long
Dim i As Long
Set sr = Sheets("girisler")
ListView3.ListItems.Clear
ListView3.FullRowSelect = True

With ListView3

For i = 2 To sr.Cells(65536, "A").End(xlUp).Row
On Error Resume Next

If VBA.CLng(VBA.CDate(sr.Cells(i, "B").Value)) >= VBA.CLng(VBA.CDate(TextBox45.Value)) And VBA.CLng(VBA.CDate(sr.Cells(i, "B").Value)) <= VBA.CLng(VBA.CDate(TextBox46.Value)) And (sr.Cells(i, "C").Value = ComboBox13.Value) Then

.ListItems.Add , , sr.Cells(i, "A")
X = X + 1
.ListItems(X).ListSubItems.Add , , sr.Cells(i, "B")
.ListItems(X).ListSubItems.Add , , sr.Cells(i, "C")
.ListItems(X).ListSubItems.Add , , sr.Cells(i, "D")
.ListItems(X).ListSubItems.Add , , sr.Cells(i, "E")
.ListItems(X).ListSubItems.Add , , sr.Cells(i, "F")
.ListItems(X).ListSubItems.Add , , sr.Cells(i, "G")
.ListItems(X).ListSubItems.Add , , sr.Cells(i, "H")
End If

Next i

End With

Set sr = Nothing
End Sub

 

[Cengizhantr06]

Lütfen bi yardım etseniz

 

[PLİNT]

Merhaba
Aşağıdaki şekilde deneyin,("Listbox" "userform" üzerinde ise işaretli aralığı "Userform_initalize" başlığı altına alırsınız)

Sub gir_tarihara()
Dim sr As Worksheet
Dim X As Long
Dim i As Long
Set sr = Sheets("girisler")
ListBox1.Clear
'************************
ListBox1.ColumnCount = 8
ListBox1.ColumnWidths = "25;50;50;50;50;50;50;50"
'**********************
With ListBox1

For i = 2 To sr.Cells(65536, "A").End(xlUp).Row
On Error Resume Next

If VBA.CLng(VBA.CDate(sr.Cells(i, "B").Value)) >= VBA.CLng(VBA.CDate(TextBox45.Value)) And VBA.CLng(VBA.CDate(sr.Cells(i, "B").Value)) <= VBA.CLng(VBA.CDate(TextBox46.Value)) And (sr.Cells(i, "C").Value = ComboBox13.Value) Then
.AddItem sr.Cells(i, "A").Text
.List(X, 1) = sr.Cells(i, "B").Text
.List(X, 2) = sr.Cells(i, "C").Text
.List(X, 3) = sr.Cells(i, "D").Text
.List(X, 4) = sr.Cells(i, "E").Text
.List(X, 5) = sr.Cells(i, "F").Text
.List(X, 6) = sr.Cells(i, "G").Text
.List(X, 7) = sr.Cells(i, "H").Text
X = X + 1
End If
Next i
End With
Set sr = Nothing
End Sub

 

[Cengizhantr06]

Merhaba
Aşağıdaki şekilde deneyin,("Listbox" "userform" üzerinde ise işaretli aralığı "Userform_initalize" başlığı altına alırsınız)

Sub gir_tarihara()
Dim sr As Worksheet
Dim X As Long
Dim i As Long
Set sr = Sheets("girisler")
ListBox1.Clear
'************************
ListBox1.ColumnCount = 8
ListBox1.ColumnWidths = "25;50;50;50;50;50;50;50"
'**********************
With ListBox1

For i = 2 To sr.Cells(65536, "A").End(xlUp).Row
On Error Resume Next

If VBA.CLng(VBA.CDate(sr.Cells(i, "B").Value)) >= VBA.CLng(VBA.CDate(TextBox45.Value)) And VBA.CLng(VBA.CDate(sr.Cells(i, "B").Value)) <= VBA.CLng(VBA.CDate(TextBox46.Value)) And (sr.Cells(i, "C").Value = ComboBox13.Value) Then
.AddItem sr.Cells(i, "A").Text
.List(X, 1) = sr.Cells(i, "B").Text
.List(X, 2) = sr.Cells(i, "C").Text
.List(X, 3) = sr.Cells(i, "D").Text
.List(X, 4) = sr.Cells(i, "E").Text
.List(X, 5) = sr.Cells(i, "F").Text
.List(X, 6) = sr.Cells(i, "G").Text
.List(X, 7) = sr.Cells(i, "H").Text
X = X + 1
End If
Next i
End With
Set sr = Nothing
End Sub

Örnek dosya atsam bi bakarmısınız lütfen çok önemli benim için comboboxdan veri secip textboxlarda girilen tarihe göre süzecek listboxda ekliyorum dosyayı

 

[PLİNT]

Formdan indiremem buraya yükleyip adresi verirmisiniz

 

[Cengizhantr06]

Formdan indiremem buraya yükleyip adresi verirmisiniz

https://www.dosyaupload.com/gdhZ çok dua edecem size

 

[PLİNT]

Aşağıdaki kodları arama butonuna ekleyip deneyin.
(arama butonu yerine "Private Sub ComboBox13_Change()" başlığı altınada yazabilirsiniz)

Private Sub butun_ara_Click()
'Sub gir_tarihara()
Dim sr As Worksheet
Dim x As Long, ls As Variant
Dim i As Long, j As Long
Set sr = Sheets("girisler")
ReDim ls(1 To 11, 1 To 1)
With ListBox2
.RowSource = ""
.ColumnHeads = False
For i = 2 To sr.Cells(65536, "A").End(xlUp).Row
'On Error Resume Next

If CDbl(VBA.CDate(sr.Cells(i, "B").Value)) >= CDbl(VBA.CDate(TextBox45.Value)) And CDbl(VBA.CDate(sr.Cells(i, "B").Value)) <= CDbl(CDate(TextBox46.Value)) And (sr.Cells(i, "C").Value = ComboBox13.Value) Then
a = a + 1
ReDim Preserve ls(1 To 11, 1 To a)
For j = 1 To 11
ls(j, a) = sr.Cells(i, j).Text
Next j

x = x + 1
End If
Next i
.Column = ls
End With
Set sr = Nothing
End Sub

 

[Cengizhantr06]

Aşağıdaki kodları arama butonuna ekleyip deneyin.
(arama butonu yerine "Private Sub ComboBox13_Change()" balığı altınada yazabilirsiniz)

Private Sub butun_ara_Click()
'Sub gir_tarihara()
Dim sr As Worksheet
Dim x As Long, ls As Variant
Dim i As Long, j As Long
Set sr = Sheets("girisler")
ReDim ls(1 To 11, 1 To 1)
With ListBox2
.RowSource = ""
.ColumnHeads = False
For i = 2 To sr.Cells(65536, "A").End(xlUp).Row
'On Error Resume Next

If CDbl(VBA.CDate(sr.Cells(i, "B").Value)) >= CDbl(VBA.CDate(TextBox45.Value)) And CDbl(VBA.CDate(sr.Cells(i, "B").Value)) <= CDbl(CDate(TextBox46.Value)) And (sr.Cells(i, "C").Value = ComboBox13.Value) Then
a = a + 1
ReDim Preserve ls(1 To 11, 1 To a)
For j = 1 To 11
ls(j, a) = sr.Cells(i, j).Text
Next j

x = x + 1
End If
Next i
.Column = ls
End With
Set sr = Nothing
End Sub

Çok güzel ama arama yapıınca column heads başlıklar kayboluyor onu çözebilirmiyiz

 

[PLİNT]

Başlıklar; sayfada filtre yaparak veya kodlarla bulunan satırların bir başka sayfaya alınması ile "RowSource" kullanarak olabilir,
ayrıca "Listbox" nesnesinin üzerine "label" eklenebilir
Yukarıdaki kodlarınızla olmuyor

 

[Cengizhantr06]

Başlıklar; sayfada filtre yaparak veya kodlarla bulunan satırların bir başka sayfaya alınması ile "RowSource" kullanarak olabilir,
ayrıca "Listbox" nesnesinin üzerine "label" eklenebilir
Yukarıdaki kodlarınızla olmuyor

Tmm çok teşekkür ederim sağolun