Boş Olan Satırlaı Listwieva Nasıl aldırmayız.

[HD1975]

Merhaba ;

Aşağıdaki kod ile T004 sayfasındaki verileri listwiev nesnesine yüklüyoruz.
Sayfada A sütunu ile AL sütunu dahil olmak üzere kullanılan sütunlar var.

Burada AB sütunu ile AL sütunu arasındaki satırlarda şöyle bir kontrol gerekiyor.

-Eğer bu iki sütun aralığındaki satırların tamamında veri yoksa bunu listwieve
getirmesin.

Şöyle ki ;
Beş nolu satırın AB ile AL sutün aralığındaki hücrelerin bir tanesinde dahi
veri olsa listwieve göndersin ama bu aralıktaki hücrelerde hiç veri yoksa bunu
göndermesin.

Private Sub ListeGuncelle3()
X = 0
Set Sh = Sheets("T002")
Son = Sh.Cells(65536, 1).End(xlUp).Row

With ListView2
.ListItems.Clear

For i = 2 To Son
aranan1 = ""
aranan2 = ""
For N = 1 To 3

If Controls("ComboBox" & N + 5) <> "" Then

If OptionButton1.Value = True Then
If N = 1 Then
aranan1 = aranan1 & UCase(Mid(Sh.Cells(i, 1).Value, 1, Len(ComboBox6)))
Else
aranan1 = aranan1 & UCase(Mid(Sh.Cells(i, N).Value, 1, Len(Controls("ComboBox" & N + 5).Value)))
End If
End If

If OptionButton2.Value = True Then
If N = 1 Then
aranan1 = aranan1 & UCase(Sh.Cells(i, 1).Value)
Else
aranan1 = aranan1 & UCase(Sh.Cells(i, N).Value)
End If
End If
aranan2 = aranan2 & UCase(Controls("ComboBox" & N + 5))
End If

Next N

aranan1 = UCase(Replace(Replace(aranan1, "I", "İ"), "i", "I"))
aranan2 = UCase(Replace(Replace(aranan2, "I", "İ"), "i", "I"))

If aranan1 = aranan2 Then


X = X + 1
'.ListItems.Add , , i
.ListItems.Add , , Sh.Cells(i, 1)
With .ListItems(X).ListSubItems

For r = 2 To 27
.Add , , Sh.Cells(i, r)
Next

End With
End If
Next i
End With
Set Sh = Nothing
End Sub



Saygılar

 

[Korhan Ayhan]

Selamlar,

Açıklamanızda T004 sayfası demişsiniz fakat kodlarınızda T002 sayfası tanımlı görünüyor. Kontrol edin.

Belirlediğiniz aralıktaki hücreleri kod içinde birleştirip kod ile uzunluğunu kontrol edebilirsiniz.

Tabiki örnek dosyanız olmadığı için kodu test edemedim.

Private Sub ListeGuncelle3()
    Dim Sütun As Byte, Veri As String
    X = 0
    Set SH = Sheets("T002")
    Son = SH.Cells(65536, 1).End(xlUp).Row
    
    With ListView2
    .ListItems.Clear
    
    For i = 2 To Son
    aranan1 = ""
    aranan2 = ""
    For N = 1 To 3
    
    If Controls("ComboBox" & N + 5) <> "" Then
    
    If OptionButton1.Value = True Then
    If N = 1 Then
    aranan1 = aranan1 & UCase(Mid(SH.Cells(i, 1).Value, 1, Len(ComboBox6)))
    Else
    aranan1 = aranan1 & UCase(Mid(SH.Cells(i, N).Value, 1, Len(Controls("ComboBox" & N + 5).Value)))
    End If
    End If
    
    If OptionButton2.Value = True Then
    If N = 1 Then
    aranan1 = aranan1 & UCase(SH.Cells(i, 1).Value)
    Else
    aranan1 = aranan1 & UCase(SH.Cells(i, N).Value)
    End If
    End If
    aranan2 = aranan2 & UCase(Controls("ComboBox" & N + 5))
    End If
    
    Next N
    
    aranan1 = UCase(Replace(Replace(aranan1, "I", "İ"), "i", "I"))
    aranan2 = UCase(Replace(Replace(aranan2, "I", "İ"), "i", "I"))
    
    If aranan1 = aranan2 Then
        
    For Sütun = 28 To 38
        Veri = Veri & SH.Cells(i, Sütun)
    Next
    
    If Len(Veri) > 0 Then
    
    X = X + 1
    '.ListItems.Add , , i
    .ListItems.Add , , SH.Cells(i, 1)
    With .ListItems(X).ListSubItems
    
    For r = 2 To 27
    .Add , , SH.Cells(i, r)
    Next
    
    End With
    End If
    End If
    Next i
    End With
    Set SH = Nothing
End Sub

 

[HD1975]

T004 sayfasına uyarladım ama olmadı..Doğru sonuç vermiyor.

 

[HD1975]

Korhan Bey ;

Çözüm varmı acaba.....

Saygılar

 

[HD1975]

Döngü ilk veriyi gördüğü hücreden sonrası tüm hücreleri alıyor.
Dönmeye devam etmiyor..