Birden fazla krıter ile Listboxa verisüzme hk.

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,666
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
merhaba
Aşağıdaki örnek kod ile listview e çok krıterli veri alabiliyorum. Fakat listview nesnesi farklı sürümlerde hata verdiği için listbox ile çalışmak istiyorum
Ek dosyada listbox a bir kritere göre veri almada sıkıntım yok.
İhtiyacım Aynı listview kodundaki gibi birden fazla krıter ile listboxa veri süzmek istiyorum.
Ek dosya da form butonu ile gelen userformda gerekli izahatı yaptım.
Teşekkür ederim.

Kod:
Set sh = Sheets("VERITABANI")
Sheets("VERITABANI").Columns.AutoFit ' EXCEL SAYFASINDAKİ SÜTUN GENİŞLİĞİNİ OTOMATİK AYARLAR
ListView1.ColumnHeaders.Clear
With ListView1
    .View = lvwReport  'ListView de buna dikkat etmeliyiz, Eğer ListWiev de burayı lvwReport olarak ayarlamazsak diğer yapılan işlemler listemizde gözükmeyecektir.
  .ColumnHeaders.Add , , sh.Range("A1"), 40
  .ColumnHeaders.Add , , sh.Range("H1"), 40
    .ColumnHeaders.Add , , sh.Range("I1"), 120
    .ColumnHeaders.Add , , sh.Range("O1"), 60
    .ColumnHeaders.Add , , sh.Range("P1"), 60
    .ColumnHeaders.Add , , sh.Range("Q1"), 60
    .ColumnHeaders.Add , , sh.Range("T1"), 60, 2
.ColumnHeaders.Add , , sh.Range("AA1"), 60, 2
.ColumnHeaders.Add , , sh.Range("AB1"), 60, 2
    .ColumnHeaders.Add , , sh.Range("U1"), 60, 2
   .FullRowSelect = True 'liste elemanını seçtiğinizde tüm satır seçili olur.
   .Gridlines = True 'Listeyi çizgili yapar.
End With
ListView1.ListItems.Clear
ListView1.FullRowSelect = True
Dim i As Long
Set sr = Sheets("VERITABANI")
With ListView1
For i = 2 To sr.Cells(65536, "A").End(xlUp).Row
If UCase(Replace(Replace(sr.Cells(i, "F").Value, "ı", "I"), "i", "İ")) _
    Like "*" & "SİPARİŞ" & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "V").Value, "ı", "I"), "i", "İ")) _
    Like "*" & "SEVK EDİLECEK" & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "O").Value, "ı", "I"), "i", "İ")) _
    Like "*" & ComboBox1.Value & "*" _
    And UCase(Replace(Replace(sr.Cells(i, "H").Value, "ı", "I"), "i", "İ")) _
    Like "*" & SEVKIYAT.TextBox1.Value & "*" Then
   .ListItems.Add , , sr.Cells(i, "A")
        X = X + 1
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "H")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "I")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "O")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "P")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "Q")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "T")
     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AA")
     .ListItems(X).ListSubItems.Add , , sr.Cells(i, "AB")
        .ListItems(X).ListSubItems.Add , , sr.Cells(i, "U")
  End If
Next i
End With
Set sr = Nothing
End Sub
 

Ekli dosyalar

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,666
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Detay açıklama,
örnek userform daki combobox da "seyhan" ı seçip textbox 2 ye "kemal" yazdığımda (B sutunu)seyhan ilçesindeki (D sutunu) kemal olanlar listelensin.
aşağıda bir şeyler yapmaya çalıştım. Next satırında hata veriyor.
Kod:
Dim s1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Veri As Range, Veri1 As Range, Say As Long


Private Sub TextBox2_Change()
Set S2 = Sheets("VERITABANI")
Worksheets("VERITABANI").AutoFilterMode = False

    ReDim Dizi(1 To 11, 1 To 1)
    
    On Error Resume Next
    ListBox1.RowSource = Empty
    ListBox1.Clear
    On Error GoTo 0
    
    If TextBox2 = "" Then
        UserForm_Initialize
    Else
    With ListBox1
        Say = 0
        Set Data = S2.Range("A2:F" & S2.Cells(Rows.Count, 2).End(3).Row)
        For Each Veri In Data
        For Each Veri1 In Data
            If Veri.Column = 4 Then
            If Veri1.Column = 2 Then
                If UCase(Replace(Replace(Veri, "i", "İ"), "ı", "I")) Like _
                "*" & UCase(Replace(Replace(TextBox2, "i", "İ"), "ı", "I")) & "*" _
                And UCase(Replace(Replace(Veri1, "i", "İ"), "ı", "I")) Like _
                "*" & UCase(Replace(Replace(ComboBox1, "i", "İ"), "ı", "I")) & "*" Then
 
                    Say = Say + 1
                    ReDim Preserve Dizi(1 To 11, 1 To Say)
                    
                    
                     Dizi(1, Say) = Veri.Offset(0, -1)
                     Dizi(2, Say) = Veri
                     Dizi(3, Say) = Veri.Offset(0, 1)
                     Dizi(4, Say) = Veri.Offset(0, 2)
                     Dizi(5, Say) = Format(Veri.Offset(0, 3), "DD.MM.YYYY")
                     Dizi(6, Say) = Veri.Offset(0, 4)
                    
                End If
            End If
           Next
        End With
        
        If Say > 0 Then ListBox1.Column = Dizi
    
    End If
    Set S2 = Nothing
End Sub
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,788
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Merhaba ben farklı userformlar ekledim irdeleyiniz.
 

Ekli dosyalar

kemal turan

Altın Üye
Katılım
10 Haziran 2011
Mesajlar
1,666
Excel Vers. ve Dili
Excel 2010 32 bit
Altın Üyelik Bitiş Tarihi
06-10-2032
Halit hocam ,
Farklı çözümleriniz için çok teşekkür ederim
Selametle Kalınız
 
Üst