bulunduğum satırı renkli göstersin

N

nes432

Altın Üye
Katılım
10 Aralık 2012
Mesajlar
301
Excel Vers. ve Dili
Ofis 365
Altın Üyelik Bitiş Tarihi
24-05-2024
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

Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
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.
Kod: 
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
 
Son düzenleme:
N

nes432

Altın Üye
Katılım
10 Aralık 2012
Mesajlar
301
Excel Vers. ve Dili
Ofis 365
Altın Üyelik Bitiş Tarihi
24-05-2024
tşk ediyorum sağolun
 
FERAZ

FERAZ

Katılım
5 Kasım 2006
Mesajlar
572
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
With ActiveCell merhabalar burdaki ActiveCell yerine Target olmalı değilmi.
Sorsammı sormasammı diye düşünürken sormuş bulundum :)
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
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.
Kod: 
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
 
İdris SERDAR

İdris SERDAR

Moderatör
Yönetici
Katılım
21 Ekim 2005
Mesajlar
17,104
Excel Vers. ve Dili
Excel, 365 - İngilizce
.

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;

Kod: 
=OR(CELL("col")=CELL("col";A1);CELL("row")=CELL("row";A1))
Kod: 
=YADA(HÜCRE("SÜTUN")=HÜCRE("SÜTUN";A1);HÜCRE("SATIR")=HÜCRE("SATIR";A1))
Şekline dönüştürün.

.
 

Ekli dosyalar

Son düzenleme:
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,434
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
FERAZ' Alıntı:
With ActiveCell merhabalar burdaki ActiveCell yerine Target olmalı değilmi.
Sorsammı sormasammı diye düşünürken sormuş bulundum :)
Genişletmek için tıkla ...
Merhaba,

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

Kod: 
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

Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
Birde bu şekilde yapılmış çalışma buldum.
Kod: 
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

FERAZ

Katılım
5 Kasım 2006
Mesajlar
572
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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

Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
FERAZ' Alıntı:
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.
Genişletmek için tıkla ...
Bu çalışmada ,hücrelerdeki koşullu biçimlendirme ve renkler silinmiyor.Onun için paylaşdım.
 
FERAZ

FERAZ

Katılım
5 Kasım 2006
Mesajlar
572
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Hücredeki çizgileride yok etmese iyiydi :)
 
Ç

çıtır

Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
FERAZ' Alıntı:
Hücredeki çizgileride yok etmese iyiydi :)
Genişletmek için tıkla ...
Ç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

FERAZ

Katılım
5 Kasım 2006
Mesajlar
572
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
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

PHP: 
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
 
Son düzenleme:
Ç

çıtır

Katılım
6 Mart 2005
Mesajlar
6,238
Excel Vers. ve Dili
Excel Vers. ve Dili:
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
22/12/2022
Bir de benim hazırladığım çizgileri ve renkleri bozmayan , hücre vurgulaması.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Üst