• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Listbox'a Şartlı Veri Getirme

  • Konbuyu başlatan Konbuyu başlatan BedriA
  • Başlangıç tarihi Başlangıç tarihi
Katılım
3 Haziran 2017
Mesajlar
797
Excel Vers. ve Dili
2007, 32
Arkadaşlar,

Aşağıdaki 1. kod ile listbox'a veri aktarıyorum.
2. satır listboxta başlık olarak görünüyor.
Ancak 2. kod ile süzme yaptığımda,
1 satır da listbox'a ekleniyor ve 2.satır listboxa ekleniyor, 1. satırda başlık oluyor.

Eğer b sütunu boş ise o satırı listboxa getirmemesi mümkün mü?

1
Kod:
Private Sub UserForm_Initialize()
    With UserForm2.ListBox1
        .ColumnCount = 12
        .ColumnWidths = "30;30;80;30;30;30;30;30;30;30;75;1"
        .ColumnHeads = True
        .RowSource = "liste!a3:l65536"
    End With
End Sub

2
Kod:
Private Sub numarayagore_Change()
Dim s1 As Worksheet, s2 As Worksheet, sonsat As Long
Set s1 = Sheets("liste")
Set s2 = Sheets("Suz")
On Error Resume Next
ListBox1.RowSource = ""
s2.Range("A:L").Clear
s1.Range("A2").AutoFilter
If numarayagore.Value = "" Then
    s1.Range("A2").AutoFilter field:=2
Else
    s1.Range("A2").AutoFilter field:=2, Criteria1:=CDbl(numarayagore.Value)
End If
s1.Range("A:L").CurrentRegion.Copy s2.Range("A1")
s1.Range("A2").AutoFilter
sonsat = s2.Cells(Rows.Count, "A").End(xlUp).Row
If sonsat > 1 Then ListBox1.RowSource = "Suz!A2:L" & sonsat
End Sub
 
Son düzenleme:
Buradan bir şey anlaşılmıyor.
Dosyanızı eklerseniz daha hızlı yanıt alabilirsiniz.:cool:
 
Merhaba. Sayın GİZLEN'in müsadeleriyle.

Her iki seçenek için de (sayfa ve userform)
aşağıdaki kod değişikliklerinin sonuç vermesi lazım.
.
Kod:
[B]Sub filtrele()[/B]
Dim s1 As Worksheet, s2 As Worksheet, sonsat As Long
Set s1 = Sheets("MUAVİN")
Set s2 = Sheets("FİLTRE")
On Error Resume Next
ListBox1.RowSource = ""
s2.Range("A:L").Clear
If Sheets("ARAMA").Range("e5") = "" Then
    s1.Range("A2").AutoFilter field:=2
Else
    s1.Range("A2:L2").AutoFilter field:=2, Criteria1:=CDbl(Sheets("ARAMA").Range("e5"))
End If
[COLOR="Red"]s1.Range("A2:L" & s1.Cells(Rows.Count, 2).End(3).Row).SpecialCells(xlCellTypeVisible).Copy s2.Range("A1")[/COLOR]
s1.Range("A2").AutoFilter
sonsat = s2.Cells(Rows.Count, "A").End(xlUp).Row
If sonsat > 1 Then ListBox1.RowSource = "MUAVİN!A2:L" & sonsat
    s2.Activate
[B]End Sub[/B]

[B]Private Sub numarayagore_Change()[/B]
Dim s1 As Worksheet, s2 As Worksheet, sonsat As Long
Set s1 = Sheets("MUAVİN")
Set s2 = Sheets("FİLTRE")
On Error Resume Next
ListBox1.RowSource = ""
s2.Range("A:L").Clear
If numarayagore.Value = "" Then
    s1.Range("A2:L2").AutoFilter field:=2
Else
    s1.Range("A2:L2").AutoFilter field:=2, Criteria1:=[COLOR="red"]numarayagore[/COLOR]
End If
[COLOR="red"]s1.Range("A2:L" & s1.Cells(Rows.Count, 2).End(3).Row).SpecialCells(xlCellTypeVisible).Copy s2.Range("A1")[/COLOR]
s1.Range("A2:L2").AutoFilter
sonsat = s2.Cells(Rows.Count, "[B][COLOR="Red"]B[/COLOR][/B]").End(xlUp).Row
If sonsat > 1 Then ListBox1.RowSource = "[B][COLOR="red"]FİLTRE[/COLOR][/B]!A2:L" & sonsat
[B]End Sub[/B]
 
Dosyanız ektedir.:cool:
 

Ekli dosyalar

Eyvallah, kolay gelsin.
 
Geri
Üst