listviewe şartlı veri alma

[muratozmenler]

iyi akşamlar....
T - AI sütunları arasındaki hücrelerin herhangi biri sarı renkli ise o satırı listviewe nasıl aldırabiliriz. fakat listviewe alınacak satırda sadece a,b,c,t-aı arası alınacak, aradaki d- s arasındaki sütundaki veriler alınmayacak.
ayrıca listviewin başlıklarıda 1. satırdakiler olacak..
çok olmaz isem renkli olan hücreninde listviewe alındığında hangisinin sarı renkli hücre olduğunu görebilmek için yazı rengini farklı gösterebilirmiyiz...

 

[halit3]

iyi akşamlar....
T - AI sütunları arasındaki hücrelerin herhangi biri sarı renkli ise o satırı listviewe nasıl aldırabiliriz. fakat listviewe alınacak satırda sadece a,b,c,t-aı arası alınacak, aradaki d- s arasındaki sütundaki veriler alınmayacak.
ayrıca listviewin başlıklarıda 1. satırdakiler olacak..
çok olmaz isem renkli olan hücreninde listviewe alındığında hangisinin sarı renkli hücre olduğunu görebilmek için yazı rengini farklı gösterebilirmiyiz...

bu kodları denermisiniz.

Private Sub ListeGuncelle1()
On Error Resume Next
Set Sh = Sheets(ActiveSheet.Name)
With ListView1
.ListItems.Clear
.ColumnHeaders.Clear
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
.LabelEdit = lvwManual
.Font.Bold = True
With .ColumnHeaders
.Add , , "Satır No", 1
On Error Resume Next
.Add , , Sh.Cells(1, 1), Sh.Columns(1).Width
.Add , , Sh.Cells(1, 2), Sh.Columns(2).Width
.Add , , Sh.Cells(1, 3), Sh.Columns(3).Width
For i = 20 To 35
.Add , , Sh.Cells(1, i)
ListView1.ColumnHeaders(i - 15).Width = Sh.Columns(i).Width
Next
End With
End With
End Sub
Sub ListeGuncelle2()
Set Sh = Sheets(ActiveSheet.Name)
With ListView1
.ListItems.Clear
For i = 2 To Sh.Cells(65536, 1).End(xlUp).Row
son = 0
For j = 1 To 35
If Sh.Cells(i, j).Interior.ColorIndex = 6 Then
son = 1
End If
Next
If son = 1 Then
x = x + 1
If x Mod 2 = 1 Then
.ListItems.Add , , i
Else
.ListItems.Add , , i
.ListItems(x).ForeColor = 255
.ListItems(x).Bold = True
End If
m = 1
With .ListItems(x).ListSubItems
For r = 1 To 35
If r <= 3 Or r >= 20 Then
If x Mod 2 = 1 Then
.Add , , Sh.Cells(i, r)
Else
.Add , , Sh.Cells(i, r)
On Error Resume Next
ListView1.ListItems(x).ListSubItems(m).ForeColor = 255 '16711680
ListView1.ListItems(x).ListSubItems(m).Bold = True
End If
m = m + 1
End If
Next
End With
End If
Next i
End With
Set Sh = Nothing
End Sub
Private Sub UserForm_Initialize()
ListeGuncelle1
ListeGuncelle2
End Sub

 

[muratozmenler]

çok teşekkür ederim halit bey sorunsuz çalışıyor; fakat yazı rengi olayı istediğim gibi olmamış yada ben yanlış anlattım sanırsam mesela tüm verileri siyah olarak alsın sadece sarı renkli olan hücreyi farklı renk yapsın istiyordum tüm satırı farklı yapmasın....bu mümkün müdür?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki linki inceleyiniz.

http://www.excel.web.tr/showthread.php?goto=newpost&t=87387

 

[halit3]

bu kodu denermisiniz.

Sub ListeGuncelle2()
Set Sh = Sheets(ActiveSheet.Name)
With ListView1
.ListItems.Clear
For i = 2 To Sh.Cells(65536, 1).End(xlUp).Row
son = 0
For j = 1 To 35
If Sh.Cells(i, j).Interior.ColorIndex = 6 Then
son = 1
End If
Next
If son = 1 Then
x = x + 1
.ListItems.Add , , i
m = 1
With .ListItems(x).ListSubItems

For r = 1 To 35
If r <= 3 Or r >= 20 Then
If Sh.Cells(i, r).Interior.ColorIndex = 6 Then
.Add , , Sh.Cells(i, r)
On Error Resume Next
ListView1.ListItems(x).ListSubItems(m).ForeColor = 255 '16711680
ListView1.ListItems(x).ListSubItems(m).Bold = True
Else
.Add , , Sh.Cells(i, r)
End If
m = m + 1
End If
Next

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

 

[muratozmenler]

çok teşekkür ederim halit bey süpersiniz vallah...

 

[halit3]

iyi çalışmalar