listbox süz yazdır

[erzen]

Arkadaşlar excel sayfasındaki durum, tutar ve tarih sütunları dışında kalan sütunları listboxa listeleyip daha sonra comboboxtan dağıtıcı adına göre süzdürmem gerekiyor. En sonda süzülen listeyi yazdırmam lazım. Forumdaki örnekleri inceledim ama beceremedim. Yardımcı olursanız sevinirim.Dosya ekte.Teşekkürler

 

[Orion1]

Dosyanız ekte.SUZ sayfası verileri süzmek için yardımcı sayfa olarak kullanılmaktadır.

Private Sub CommandButton1_Click()
Dim sh As Worksheet, deg As String
Set sh = Sheets("SUZ")
sh.Range("A1:U65536").ClearContents
If ComboBox1.Value = "" Then
    deg = "*"
    Else
    deg = ComboBox1.Value
End If
With Sheets("Sayfa1")
    .Range("A1").AutoFilter
    .Range("A1").AutoFilter , field:=1, Criteria1:=deg
    .Range("A1:U" & .Cells(65536, "A").End(xlUp).Row).CurrentRegion.Copy sh.Range("A1")
    .Range("A1").AutoFilter
    ListBox1.RowSource = "SUZ!A2:U" & sh.Cells(65536, "A").End(xlUp).Row
End With
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
Dim i As Byte, baslik As String, deg As String
For i = 1 To 21
    deg = Sheets("Sayfa1").Cells(1, i).Value
    If deg = "DURUM" Or deg = "TUTAR" Or deg = "TARİH" Then
        baslik = baslik & ";0"
        Else
        baslik = baslik & ";120"
    End If
Next i
baslik = Right(baslik, Len(baslik) - 1)
ListBox1.ColumnCount = 21
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = baslik
ListBox1.RowSource = "Sayfa1!A2:U" & Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row

End Sub

 

[ramboberk]

Dosyanız ekte.SUZ sayfası verileri süzmek için yardımcı sayfa olarak kullanılmaktadır.

Private Sub CommandButton1_Click()
Dim sh As Worksheet, deg As String
Set sh = Sheets("SUZ")
sh.Range("A1:U65536").ClearContents
If ComboBox1.Value = "" Then
    deg = "*"
    Else
    deg = ComboBox1.Value
End If
With Sheets("Sayfa1")
    .Range("A1").AutoFilter
    .Range("A1").AutoFilter , field:=1, Criteria1:=deg
    .Range("A1:U" & .Cells(65536, "A").End(xlUp).Row).CurrentRegion.Copy sh.Range("A1")
    .Range("A1").AutoFilter
    ListBox1.RowSource = "SUZ!A2:U" & sh.Cells(65536, "A").End(xlUp).Row
End With
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
Dim i As Byte, baslik As String, deg As String
For i = 1 To 21
    deg = Sheets("Sayfa1").Cells(1, i).Value
    If deg = "DURUM" Or deg = "TUTAR" Or deg = "TARİH" Then
        baslik = baslik & ";0"
        Else
        baslik = baslik & ";120"
    End If
Next i
baslik = Right(baslik, Len(baslik) - 1)
ListBox1.ColumnCount = 21
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = baslik
ListBox1.RowSource = "Sayfa1!A2:U" & Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row

End Sub

Evren Bey, kodlarınızı denedim ama bir türlü kendi deneme dosyama uyarlıyamadım. Zamanınız olursa benimkinede bakarsanız sevinirim. Teşekkürler

http://www.excel.web.tr/showthread.php?p=391415#post391415