Siteden aldığım Seçili Satırı Renklendirme Makrosu

yastık · 29 Ocak 2015

merhaba arkadaşlar aşağıdaki macro çok iyi çalışıyor fakat bana göre bir iki ufak düzeltme olursa daha güzel olacak.

exceli kapatıp açtığımda en son hangi satır ve sütundaysa o sütün macrodaki renk kodu olan 6 yani sarı olarak kayıt edilmiş olarak açılıyor ve düzeltemiyorsunuz. düzeltmek değilde renkli olarak kayıt etmesini istemiyorum.

ayrıca sadece A ile T arasında renklendirme yapmasını istiyorum

belirttiğim bu iki konuyu hallettmek için macroya nasıl bir ilave kod yazılmalıdır acaba? yardımcı olmanızı rica ederim.

Bir ilave; takılmadan çalışması için de yapılabilecek birşey varmıdır? imleci klavyedeki oklarını kullanarak sağa, sola, yukarı, aşağı hareket ettirdiğimde bariz takılmalar oluyor.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static EskiHucre As Range ', EskiHucre2 As Range
Static SatirRenkDizisi(256) As Integer
'Static SutunRenkDizisi(65536) As Long
Dim bulent As Integer
'Dim excelce As Long
If Not EskiHucre Is Nothing Then
For bulent = 1 To 256
Cells(EskiHucre.Row, bulent).Interior.ColorIndex = SatirRenkDizisi(bulent)
Next bulent
' For excelce = 1 To 65536
' Cells(excelce, EskiHucre2.Column).Interior.ColorIndex = SutunRenkDizisi(excelce)
' Next excelce
End If
For bulent = 1 To UBound(SatirRenkDizisi)
SatirRenkDizisi(bulent) = Cells(ActiveCell.Row, bulent).Interior.ColorIndex
Next bulent
'For excelce = 1 To UBound(SutunRenkDizisi)
' SutunRenkDizisi(excelce) = Cells(excelce, ActiveCell.Column).Interior.ColorIndex
'Next excelce
ActiveCell.EntireRow.Interior.ColorIndex = 6
'ActiveCell.EntireColumn.Interior.ColorIndex = 6
Set EskiHucre = ActiveCell.EntireRow
'Set EskiHucre2 = ActiveCell.EntireColumn
End Sub

halit3 · 29 Ocak 2015

Alternatif olarak koşullu biçimlendirme ile yapılmıştır.

kod A2:T50 arası çalışmaktadır.

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("[COLOR="Red"]A2:T50[/COLOR]").FormatConditions.Delete
If Intersect(Target, Range([COLOR="red"]"A2:T50[/COLOR]")) Is Nothing Then Exit Sub
With Range("[COLOR="red"]A[/COLOR]" & Target.Row, "[COLOR="red"]T[/COLOR]" & Target.Row)
.FormatConditions.Add Type:=2, Formula1:=-1
.FormatConditions(1).Interior.ColorIndex = 6
End With
End Sub

Necdet · 29 Ocak 2015

Merhaba,

İkinci seçenek olsun, kendim için hazırladığım kodlar.

1. satırın başlık ve A sütunun ilk dolu sütun olduğu kabul edilmiştir.

Sütün sayısı ile sabit değildir.

Public Sat As Long
Public SonKolon As Integer
Public secim As Range

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Sat = Target.Row Then
        Exit Sub
    Else
        Sat = Target.Row
    End If
    Set secim = Range("A1").CurrentRegion
    SonKolon = secim.Columns.Count
    Cells.Interior.ColorIndex = xlNone
    If Target.Row = 1 Then Exit Sub
    Range(Cells(Target.Row, "A"), Cells(Target.Row, SonKolon)).Interior.ColorIndex = 6
    
End Sub

yastık · 29 Ocak 2015

halit3' Alıntı:

Alternatif olarak koşullu biçimlendirme ile yapılmıştır.

kod A2:T50 arası çalışmaktadır.

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("[COLOR="Red"]A2:T50[/COLOR]").FormatConditions.Delete
If Intersect(Target, Range([COLOR="red"]"A2:T50[/COLOR]")) Is Nothing Then Exit Sub
With Range("[COLOR="red"]A[/COLOR]" & Target.Row, "[COLOR="red"]T[/COLOR]" & Target.Row)
.FormatConditions.Add Type:=2, Formula1:=-1
.FormatConditions(1).Interior.ColorIndex = 6
End With
End Sub

Kod sayfasına kopyala yapıştır yaptım ama çalışmadı biryerde hatamı yapıyorum acaba? koşulu biçimlendirmenin formül kısmına mı eklemeliyim?

halit3 · 29 Ocak 2015

yastık' Alıntı:
Kod sayfasına kopyala yapıştır yaptım ama çalışmadı biryerde hatamı yapıyorum acaba? koşulu biçimlendirmenin formül kısmına mı eklemeliyim?

Profilinizde excelin hangi sürümünü kullandığınız yazmıyor bunu düzeltin

kod ofis 2003 ve ofis 2007 de çalışıyor

yastık · 29 Ocak 2015

Necdet Yeşertener' Alıntı:
Merhaba,

İkinci seçenek olsun, kendim için hazırladığım kodlar.

1. satırın başlık ve A sütunun ilk dolu sütun olduğu kabul edilmiştir.

Sütün sayısı ile sabit değildir.

Public Sat As Long
Public SonKolon As Integer
Public secim As Range

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Sat = Target.Row Then Exit Sub Else Sat = Target.Row End If Set secim = Range("A1").CurrentRegion SonKolon = secim.Columns.Count Cells.Interior.ColorIndex = xlNone If Target.Row = 1 Then Exit Sub Range(Cells(Target.Row, "A"), Cells(Target.Row, SonKolon)).Interior.ColorIndex = 6 End Sub

elinize sağlık çok güzel çalışıyor fakat çok yavaş imleci hareket ettirince bir süre bekletiyor sonra satır değiştiriyor, daha hızlı çalışması için yapacak birşeyler varmıdır?

yastık · 29 Ocak 2015

halit3' Alıntı:
Profilinizde excelin hangi sürümünü kullandığınız yazmıyor bunu düzeltin

kod ofis 2003 ve ofis 2007 de çalışıyor

Excel 2007 kullanıyorum profilden de birazdan düzelteceğim. teşekkürler.

Necdet · 29 Ocak 2015

Merhaba,

Dosya büyük olduğunda ilk verdiğim kodlarda sıkıntı oluşabilirdi.
Aşağıdaki kodlarda bu sorunu hallettiğimi düşünüyorum.

Deneyip sonucu bildirirseniz sevinirim.

Kod:

Public Sat  As Long
Public Kol  As Integer

Private Sub Worksheet_Activate()

    Cells.Interior.ColorIndex = xlNone
    Range("A2").Activate
    Sat = 2
    Kol = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    Range(Cells(Sat, "A"), Cells(Sat, Kol)).Interior.ColorIndex = 6
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Sat = Target.Row Then
        Exit Sub
    Else
        If Sat = 0 Then Sat = Target.Row
        Range(Cells(Sat, "A"), Cells(Sat, Kol)).Interior.ColorIndex = xlNone
        Sat = Target.Row
    End If
    If Target.Row = 1 Then Exit Sub
    Range(Cells(Target.Row, "A"), Cells(Target.Row, Kol)).Interior.ColorIndex = 6
    
End Sub

halit3 · 29 Ocak 2015

görsel video

yastık · 29 Ocak 2015

halit3' Alıntı:
görsel video

Halit bey aynısı yaptım ama çalışmıyor çok entresan ben biraz daha kurcalayayım teşekkür ederim.

Necdet · 29 Ocak 2015

8 nolu mesaj için bir düşünceniz var mı?

yastık · 29 Ocak 2015

halit3' Alıntı:

Alternatif olarak koşullu biçimlendirme ile yapılmıştır.

kod A2:T50 arası çalışmaktadır.

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("[COLOR="Red"]A2:T50[/COLOR]").FormatConditions.Delete
If Intersect(Target, Range([COLOR="red"]"A2:T50[/COLOR]")) Is Nothing Then Exit Sub
With Range("[COLOR="red"]A[/COLOR]" & Target.Row, "[COLOR="red"]T[/COLOR]" & Target.Row)
.FormatConditions.Add Type:=2, Formula1:=-1
.FormatConditions(1).Interior.ColorIndex = 6
End With
End Sub

Halit bey mevcut excelimde işe yaramadı ama yeni bir excel açtığımda oluyor ama onda da şöyle bir uyarı veriyor

Gizlilik uyarısı: Bu belge makrolar, activex denetimleriXML genişletme paketi bilgileri veya WEB bileşenleri içeriyor. Bunlar belge denetçisi tarafından kaldırılamayan kişisel bilgiler olabilir.

yastık · 29 Ocak 2015

Necdet Yeşertener' Alıntı:

Merhaba,

Dosya büyük olduğunda ilk verdiğim kodlarda sıkıntı oluşabilirdi.
Aşağıdaki kodlarda bu sorunu hallettiğimi düşünüyorum.

Deneyip sonucu bildirirseniz sevinirim.

Kod:

Public Sat  As Long
Public Kol  As Integer

Private Sub Worksheet_Activate()

    Cells.Interior.ColorIndex = xlNone
    Range("A2").Activate
    Sat = 2
    Kol = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    Range(Cells(Sat, "A"), Cells(Sat, Kol)).Interior.ColorIndex = 6
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Sat = Target.Row Then
        Exit Sub
    Else
        Range(Cells(Sat, "A"), Cells(Sat, Kol)).Interior.ColorIndex = xlNone
        Sat = Target.Row
    End If
    If Target.Row = 1 Then Exit Sub
    Range(Cells(Target.Row, "A"), Cells(Target.Row, Kol)).Interior.ColorIndex = 6
    
End Sub

Necdet bey bunu görmemişim kusura bakmayın. Denedim aşağıdaki kodla ilgili bir uyarı verdi.

Range(Cells(Sat, "A"), Cells(Sat, Kol)).Interior.ColorIndex = xlNone

halit3 · 29 Ocak 2015

ofis 2007 için görsel video

halit3 · 29 Ocak 2015

yastık' Alıntı:
Halit bey mevcut excelimde işe yaramadı ama yeni bir excel açtığımda oluyor ama onda da şöyle bir uyarı veriyor

Gizlilik uyarısı: Bu belge makrolar, activex denetimleriXML genişletme paketi bilgileri veya WEB bileşenleri içeriyor. Bunlar belge denetçisi tarafından kaldırılamayan kişisel bilgiler olabilir.

Aşağıdaki linke irdeleyiniz.

http://www.excel.web.tr/f14/gizlilik-uyarysyny-kaldyrmak-mumkun-mu-t91572.html

yastık · 29 Ocak 2015

halit3' Alıntı:
Aşağıdaki linke irdeleyiniz.

http://www.excel.web.tr/f14/gizlilik-uyarysyny-kaldyrmak-mumkun-mu-t91572.html

teşekkür ederim.

Necdet · 29 Ocak 2015

yastık' Alıntı:
Necdet bey bunu görmemişim kusura bakmayın. Denedim aşağıdaki kodla ilgili bir uyarı verdi.

Range(Cells(Sat, "A"), Cells(Sat, Kol)).Interior.ColorIndex = xlNone

kodları ilk defa denerken verir o hatayı.

sayfa değiştirip kullanırsanız ve sonraki kullanımlarda hata vermez.

Not : Yine de 8. mesajdaki kodlar yenilendi.

Korhan Ayhan · 29 Ocak 2015

Merhaba,

Aşağıdaki linkte daha önce bu konuda örnekler hazırlanmıştı. İnceleyiniz. Belki işinize yarayabilir.

Satır Renklendirme

Siteden aldığım Seçili Satırı Renklendirme Makrosu

yastık

halit3

Uzman

Necdet

Moderatör

yastık

halit3

Uzman

yastık

yastık

Necdet

Moderatör

halit3

Uzman

yastık

Necdet

Moderatör

yastık

yastık

halit3

Uzman

halit3

Uzman

yastık

Necdet

Moderatör

Korhan Ayhan

Administrator