• DİKKAT

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

Satır renklendirme sınırlama

Katılım
17 Nisan 2013
Mesajlar
101
Excel Vers. ve Dili
2007 Microsoft Office Türkçe
Aşağıdaki kodu 5. satır ile 155 satır arasında çalıştırabilirmiyiz.
yardımcı olursanız sevinirim ...

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Const kolonsayisi As Long = 20
Const prenkliler As Long = 20
Static eskirenk As Range
Static renkliyer(1 To kolonsayisi) As Long
Dim i As Long
If Not eskirenk Is Nothing Then
With eskirenk.Cells
If .Row = ActiveCell.Row Then Exit Sub
For i = 1 To kolonsayisi
.Item(i).Interior.ColorIndex = renkliyer(i)
Next i
End With
End If
Set eskirenk = Cells(ActiveCell.Row, 1).Resize(1, kolonsayisi)
With eskirenk
For i = 1 To kolonsayisi
renkliyer(i) = .Item(i).Interior.ColorIndex
Next i
.Interior.ColorIndex = prenkliler
End With
End Sub
 

Ekli dosyalar

Son düzenleme:
Aşağıdaki kodu 5. satır ile 155 satır arasında çalıştırabilirmiyiz.
yardımcı olursanız sevinirim ...

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Const kolonsayisi As Long = 20
Const prenkliler As Long = 20
Static eskirenk As Range
Static renkliyer(1 To kolonsayisi) As Long
Dim i As Long
If Not eskirenk Is Nothing Then
With eskirenk.Cells
If .Row = ActiveCell.Row Then Exit Sub
For i = 1 To kolonsayisi
.Item(i).Interior.ColorIndex = renkliyer(i)
Next i
End With
End If
Set eskirenk = Cells(ActiveCell.Row, 1).Resize(1, kolonsayisi)
With eskirenk
For i = 1 To kolonsayisi
renkliyer(i) = .Item(i).Interior.ColorIndex
Next i
.Interior.ColorIndex = prenkliler
End With
End Sub

ayrıca bu kod sayfadan satır silip hücreye tıklayınca hata veriyor :(
 
Aşağıdaki kodu 5. satır ile 155 satır arasında çalıştırabilirmiyiz.
yardımcı olursanız sevinirim ...

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Const kolonsayisi As Long = 20
Const prenkliler As Long = 20
Static eskirenk As Range
Static renkliyer(1 To kolonsayisi) As Long
Dim i As Long
If Not eskirenk Is Nothing Then
With eskirenk.Cells
If .Row = ActiveCell.Row Then Exit Sub
For i = 1 To kolonsayisi
.Item(i).Interior.ColorIndex = renkliyer(i)
Next i
End With
End If
Set eskirenk = Cells(ActiveCell.Row, 1).Resize(1, kolonsayisi)
With eskirenk
For i = 1 To kolonsayisi
renkliyer(i) = .Item(i).Interior.ColorIndex
Next i
.Interior.ColorIndex = prenkliler
End With
End Sub

yardımcı olacak arkadaş yokmu :(
 
dosya ekledim :)
 
Geri
Üst