bulunduğum satırı renkli göstersin

[nes432]

merhaba,

çok sayıda rakamsal verii girmem gerekiyor. o nedenle veri girerken yanış satıra bakmamam için bulunduğum satırı renkli göstermesini istiyorum.
Boyle bir şey mümkün müdür?

 

[çıtır]

Bulunduğunuz satırı ve sütunu renkli gösterir.Bulunduğunuz hücreyi büyütür.Sayfa kodu olarak kopyalayınız.
Not:Forumdan almıştım.Kimin hazırladığını bilmiyorum.Alanları kendinize göre ayarlayınız.Hazırlayana çok teşekkür ediyorum.Çok kullanışlı bir çalışma.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B3:AO64")) Is Nothing Then
    Cells.FormatConditions.Delete
    Exit Sub
End If
Dim Satır As Range, Sütun As Range
    Set Satır = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 41))
    Set Sütun = Range(Cells(Target.Row, ActiveCell.Column), Cells(3, ActiveCell.Column))
   Cells.FormatConditions.Delete
   With Satır
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
     With Sütun
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 8
    End With
   With Target
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
   On Error GoTo Son
With [B3:AO64]
    Cells.Font.Size = 10
    Cells.Font.Italic = False
End With
If Intersect(Target, [B3:AO64]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Not IsEmpty(Target) Then
Target.Font.Size = 20
Target.Font.Italic = True
End If
Son:
Application.ScreenUpdating = True
End Sub

 

[nes432]

tşk ediyorum sağolun

 

[çıtır]

tşk ediyorum sağolun

Rica ederim.Dönüş yaptığınız için teşekkür ederim.

 

[çıtır]

arşivlik teşekkürler.

Rica ederim.İyi günler.

 

[FERAZ]

With ActiveCell merhabalar burdaki ActiveCell yerine Target olmalı değilmi.
Sorsammı sormasammı diye düşünürken sormuş bulundum

 

[Ömer BARAN]

Merhaba.
Ben de bir alternatif vereyim (işlem yapılacak sayfanın kod bölümüne uygulayın).
Belgede renklendirme yoksa (kod işlem öncesi, mevcut renklendirmeleri siler) seçili satır ve sütunun renklenmesi için kullanılabilir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Count > 1 Then Exit Sub
    Cells.Interior.Color = xlNone
    Range(Cells(1, Target.Column), Cells(Rows.Count, Target.Column)).Interior.ColorIndex = 34
    Range(Cells(Target.Row, 1), Cells(Target.Row, Columns.Count)).Interior.ColorIndex = 34
    Target.Interior.ColorIndex = 36
End Sub

 

[Merhum İdris SERDAR]

.

Bir Alternatif:

Koşullu biçimlendirme ve sayfa kodlarına bakın.

http://www.dosya.tc/server16/cnmvlf/satsutizle.rar.html


Not: Excel Türkçe için Koşullu Biçimlendirmede yer alan formülü;

Örneğin;

=OR(CELL("col")=CELL("col";A1);CELL("row")=CELL("row";A1))

=YADA(HÜCRE("SÜTUN")=HÜCRE("SÜTUN";A1);HÜCRE("SATIR")=HÜCRE("SATIR";A1))

Şekline dönüştürün.

.

 

[Korhan Ayhan]

With ActiveCell merhabalar burdaki ActiveCell yerine Target olmalı değilmi.
Sorsammı sormasammı diye düşünürken sormuş bulundum

Merhaba,

Aşağıdaki kod boş bir excel dosyasında deneyin. Kodu uyguladıktan sonra sayfada alan seçip sonucu gözlemleyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Cells.FormatConditions.Delete
   With ActiveCell
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 6
    End With
End Sub

Daha sonra aynı kodu "ActveCell" yerine "Target" yazıp deneyin ve aradaki farkı görün.

İsteğe göre her iki şekilde de kullanılabilir.

 

[çıtır]

Birde bu şekilde yapılmış çalışma buldum.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
    Dim aaa As DisplayFormat
    Set aaa = Range("XFD1048576").DisplayFormat
    Range("A1:XFD500").Borders.Color = aaa.Borders.Color
    Range("A1:XFD500").Borders.LineStyle = aaa.Borders.LineStyle
    Dim i As Integer
    For i = xlEdgeLeft To xlEdgeRight
        Target.EntireRow.Resize(1, 100).Borders.Item(i).Color = vbRed
        Target.EntireRow.Resize(1, 100).Borders.Item(i).Weight = xlThick
        Target.EntireColumn.Resize(500, 1).Borders.Item(i).Color = vbRed
        Target.EntireColumn.Resize(500, 1).Borders.Item(i).Weight = xlThick
Next i
With [A1:AO64]
    Cells.Font.Size = 10
    Cells.Font.Italic = False
End With
If Intersect(Target, [A1:AO64]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Target.Font.Size = 20
Target.Font.Italic = True
Application.ScreenUpdating = True
End Sub

 

[FERAZ]

Hücrelerde koşullu biçimlendirme varsa bu seçim o koşullu biçimlendirmeye geliyorsa nasıl olacak.O zaman koşullu biçimlendirme silinecek.

 

[çıtır]

Hücrelerde koşullu biçimlendirme varsa bu seçim o koşullu biçimlendirmeye geliyorsa nasıl olacak.O zaman koşullu biçimlendirme silinecek.

Bu çalışmada ,hücrelerdeki koşullu biçimlendirme ve renkler silinmiyor.Onun için paylaşdım.

 

[FERAZ]

Elinize sağlık.

 

[çıtır]

Elinize sağlık.

Bende bir sitede gördüm ve paylaşmak istedim.Teşekkür ederim.

 

[FERAZ]

Hücredeki çizgileride yok etmese iyiydi

 

[çıtır]

Hücredeki çizgileride yok etmese iyiydi

Çizgileri koşullu biçimlendirme yapınız.Şimdilik bulduğum çözüm bu.Başka çözüm bulursam paylaşırım veya bildiğiniz çözüm varsa lütfen sizde paylaşınız.

 

[FERAZ]

Bir dosya yaptım bende şaştım nasıl yaptım
Kosullu adında bir sayfa ekleyip oraya 1 ve 2 yazdırdım.




http://s3.dosya.tc/server18/m4uxw1/e_aktif_hucre_renklensin_Renk_Bozulmadan_.rar.html

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim ws As Worksheet, aa As Integer, bb As Integer, cc As Integer

Set ws = ThisWorkbook.Sheets("Kosullu")
On Error GoTo son
If Target.Count > 1 Then GoTo son

Application.ScreenUpdating = False
  ws.Cells.ClearContents

    bb = 50
    
        If Target.Column < 50 Then
            cc = 1 - Target.Column
        Else
            cc = -50
        End If
    
        If Target.Row < 50 Then
            aa = 1 - Target.Row
        Else
            aa = -50
        End If
    
    
    ws.Range(Target.Address, ws.Range(Target.Address).Offset(0, cc)).Value = 1
    ws.Range(Target.Address, ws.Range(Target.Address).Offset(0, 50)).Value = 1
    ws.Range(Target.Address, ws.Range(Target.Address).Offset(aa, 0)).Value = 1
    ws.Range(Target.Address, ws.Range(Target.Address).Offset(50, 0)).Value = 1
    ws.Range(Target.Address) = 2
   
Application.ScreenUpdating = True
Exit Sub
son:
ws.Cells.ClearContents
Set ws = Nothing
End Sub

 

[netzone]

https://www.excel.web.tr/threads/excelde-mouseover-oezelligi-var-mi.174503/

 

[Korhan Ayhan]

Başka bir alternatif;

Örnek dosyayı deneyiniz.

Harici link (Silinebilir) ; http://s7.dosya.tc/server11/u9xm4m/Ornek.rar.html

 

[çıtır]

Bir de benim hazırladığım çizgileri ve renkleri bozmayan , hücre vurgulaması.