Soru Boş Hücrelerin Renklenmesi

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Herkese Merhaba
Birden fazla sekmesi olan excel kitabım var.
Benim şöyle bir makroya ihtiyacım var. Sayfa açıldı mı anlık bu makro çalışacak. Hücreler veya hücre aralığı boşaldı mı yeşil olacak .

VERİ ALANI 1, VERİ ALANI 2, VERİ ALANI 3 diye VERİ ALANI 30 a kadar gidiyor.

VERİ ALANI 1, 2 ve 3 te
E10 E15 arasında en az bir hücre dolu değilse E10 E15 arası yeşil olsun.

VERİ ALANI 1, 2 veya 3 te
E20 E30 arasında en az bir hücre dolu değilse E20 E30 arası yeşil olsun.

VERİ ALANI 1, 2 veya 3 te
E5 E9 arasında en az bir hücre dolu değilse E5 E9 arası yeşil olsun.

VERİ ALANI 1, 2 veya 3 te
E45 hücresi dolu değilse E45 yeşil olsun.

Not: Dolu ifadesinden kastım en az bir karekter yazılması yeterlidir .

Şöyle bir şeyler yapmaya çalıştım ama olmadı.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

Dim VERİ ALANI 1, VERİ ALANI 2, VERİ ALANI 3 Worksheets
Set syf = ActiveSheet
    If Range("E5:E9") = " " Then
        Range("E5:E9").Interior.Color = vbGreen
    End If

If Range("E10:E15") = " " Then
        Range("E10:E15").Interior.Color = vbGreen
    End If


If Range("E20:E30") = " " Then
        Range("E5:E9").Interior.Color = vbGreen
    End If


If Range("E45") = " " Then
        Range("E45").Interior.Color = vbGreen
    End If

End Sub
 
C

cicosz

Katılım
30 Mart 2010
Mesajlar
240
Excel Vers. ve Dili
2007,2010,2013
Altın Üyelik Bitiş Tarihi
29-05-2021
Merhaba,

"Veri Alanı" olarak bahsettiğiniz kısmı tam anlayamadım ama belirttiğiniz aralıkta koşula göre aralık renklendirmesiyle ilgili aşağıdaki kodu hazırladım. İşinizi görür mü?

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("E1:E45"), Target) Is Nothing Then

    n1 = ActiveSheet.Range("E5:E9").Cells.SpecialCells(xlCellTypeConstants).Count
        If n1 < 5 Then
        ActiveSheet.Range("E5:E9").Interior.Color = vbGreen
        Else
        ActiveSheet.Range("E5:E9").Interior.ColorIndex = xlNone
        End If
    
    n2 = ActiveSheet.Range("E10:E15").Cells.SpecialCells(xlCellTypeConstants).Count
        If n2 < 6 Then
        ActiveSheet.Range("E10:E15").Interior.Color = vbGreen
        Else
        ActiveSheet.Range("E10:E15").Interior.ColorIndex = xlNone
        End If
    
    n3 = ActiveSheet.Range("E20:E30").Cells.SpecialCells(xlCellTypeConstants).Count
        If n3 < 11 Then
        ActiveSheet.Range("E20:E30").Interior.Color = vbGreen
        Else
        ActiveSheet.Range("E20:E30").Interior.ColorIndex = xlNone
        End If
    
        If Range("E45") = "" Then
        ActiveSheet.Range("E45").Interior.Color = vbGreen
        Else
        ActiveSheet.Range("E45").Interior.ColorIndex = xlNone
        End If

End If

End Sub
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
cicosz' Alıntı:
Merhaba,

"Veri Alanı" olarak bahsettiğiniz kısmı tam anlayamadım ama belirttiğiniz aralıkta koşula göre aralık renklendirmesiyle ilgili aşağıdaki kodu hazırladım. İşinizi görür mü?

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("E1:E45"), Target) Is Nothing Then

    n1 = ActiveSheet.Range("E5:E9").Cells.SpecialCells(xlCellTypeConstants).Count
        If n1 < 5 Then
        ActiveSheet.Range("E5:E9").Interior.Color = vbGreen
        Else
        ActiveSheet.Range("E5:E9").Interior.ColorIndex = xlNone
        End If
    
    n2 = ActiveSheet.Range("E10:E15").Cells.SpecialCells(xlCellTypeConstants).Count
        If n2 < 6 Then
        ActiveSheet.Range("E10:E15").Interior.Color = vbGreen
        Else
        ActiveSheet.Range("E10:E15").Interior.ColorIndex = xlNone
        End If
    
    n3 = ActiveSheet.Range("E20:E30").Cells.SpecialCells(xlCellTypeConstants).Count
        If n3 < 11 Then
        ActiveSheet.Range("E20:E30").Interior.Color = vbGreen
        Else
        ActiveSheet.Range("E20:E30").Interior.ColorIndex = xlNone
        End If
    
        If Range("E45") = "" Then
        ActiveSheet.Range("E45").Interior.Color = vbGreen
        Else
        ActiveSheet.Range("E45").Interior.ColorIndex = xlNone
        End If

End If

End Sub
Genişletmek için tıkla ...
Hocam VERİ ALANI 1,2,3 dediğim excdl kitabındaki sayfa isimleri

Şu kısımları anlamadım

n1 = ActiveSheet.Range("E5:E9").Cells.SpecialCells(xlCellTypeConstants).Count
If n1 < 5 Then
ActiveSheet.Range("E5:E9").Interior.Color = vbGreen
Else
Bu kısımlarda yani E5 E9 aralığında bir hücre bile dolu olsa yeşil olacak. E5 E9 arasındaki tüm hücrelerin dolu olmasına gerek yok.

Malesef bilgisayar olmadığı için deneyemedim.
 
C

cicosz

Katılım
30 Mart 2010
Mesajlar
240
Excel Vers. ve Dili
2007,2010,2013
Altın Üyelik Bitiş Tarihi
29-05-2021
Merhaba,

Belirttiğiniz aralıkların her birisi için dolu hücre sayısını alıp, bu sayıyı o aralıktaki hücre sayısıyla karşılaştırdım.

n1 den örnek verecek olursak;
E5:E9 aralığında 5 hücre yer almaktadır. Sizin isteğiniz de aralıktaki en az bir hücre boşsa o aralığı yeşil renkle dolgu yapmak şeklindeydi. ( "en az bir hücre dolu değilse" dediğinizi ben en az bir hücre boşsa şeklinde yorumladım ). SpecialCells(xlCellTypeConstants).Count kısmı ile dolu hücreleri saydırdım. Dolayısıyla E5:E9 arasındaki dolu hücre sayısı 5 ten küçükse o aralığı yeşil dolgu yaptım. Else kısmında ise aralıktaki hücrelerin tamamı doluysa dolguyu kaldırdım.
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
cicosz' Alıntı:
Merhaba,

Belirttiğiniz aralıkların her birisi için dolu hücre sayısını alıp, bu sayıyı o aralıktaki hücre sayısıyla karşılaştırdım.

n1 den örnek verecek olursak;
E5:E9 aralığında 5 hücre yer almaktadır. Sizin isteğiniz de aralıktaki en az bir hücre boşsa o aralığı yeşil renkle dolgu yapmak şeklindeydi. ( "en az bir hücre dolu değilse" dediğinizi ben en az bir hücre boşsa şeklinde yorumladım ). SpecialCells(xlCellTypeConstants).Count kısmı ile dolu hücreleri saydırdım. Dolayısıyla E5:E9 arasındaki dolu hücre sayısı 5 ten küçükse o aralığı yeşil dolgu yaptım. Else kısmında ise aralıktaki hücrelerin tamamı doluysa dolguyu kaldırdım.
Genişletmek için tıkla ...
Hocam istediğim bu değil aslında.

Benim istediğim E5:E9 aralığında 5 hücre var eğer E5:E9 arasında en az bir hücre dolu değilse E5:E9 aralığındaki 5 hücre de yeşil renk olsun ama misal E7 dolu ise E5:E9 arası renklenmesin. şeklinde
 
C

cicosz

Katılım
30 Mart 2010
Mesajlar
240
Excel Vers. ve Dili
2007,2010,2013
Altın Üyelik Bitiş Tarihi
29-05-2021
Merhaba,

E5:E9 arasında boşluk doluluk şartı sağlansa bile E7 doluysa aralığın dolgu yapmamasını istiyorsunuz. Bu kısım doğru mu? Doğruysa Diğer aralıklarda dolgu yapılmaması için koşul olacak hücreleri hangileridir?
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
VERİ ALANI 1, 2 veya 3 te
E10 E15 arasında en az bir hücre dolu değilse E10 E15 arası yeşil olsun.

VERİ ALANI 1, 2 veya 3 te
E20 E30 arasında en az bir hücre dolu değilse E20 E30 arası yeşil olsun.

VERİ ALANI 1, 2 veya 3 te
E5 E9 arasında en az bir hücre dolu değilse E5 E9 arası yeşil olsun.

VERİ ALANI 1, 2 veya 3 te
E45 hücresi dolu değilse E45 yeşil olsun.
 
C

cicosz

Katılım
30 Mart 2010
Mesajlar
240
Excel Vers. ve Dili
2007,2010,2013
Altın Üyelik Bitiş Tarihi
29-05-2021
Merhaba,

#2 nolu mesajdaki kodu deneyiniz. Denedikten sonra eksik gördüğünüz yerler varsa onun üzerinden devam edelim. Kod tek sayfa olmak üzere ActiveSheet’ te işlem yapar. Duruma göre tüm çalışma kitabını kapsayacak şekle çevirebiliriz. Bunlardan önce algoritmanın doğruluğunu test edelim.
 
FERAZ

FERAZ

Katılım
5 Kasım 2006
Mesajlar
602
Excel Vers. ve Dili
TÜRKCE Excel 2021 32bit
Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)

'Altaekleme yapilabilir

Renk [E5:E9], Target.Row, Target.Column, 5, 9 '5 demek E5 deki,9 demek E9 daki

Renk [E20:E30], Target.Row, Target.Column, 20, 30

End Sub



Sub Renk(alan As Range, aktifSatir As Integer, aktifSutun As Byte, bas As Integer, son As Integer) 'Burasi degistirilmeyecek

    If (aktifSatir >= bas And aktifSatir <= son) And aktifSutun = 5 Then

        If WorksheetFunction.CountA(alan) > 0 Then

            alan.Interior.Color = xlNone

        Else

            alan.Interior.Color = vbGreen

        End If

    End If

   Set alan = Nothing

End Sub
 
Saban Sertkaya

Saban Sertkaya

Katılım
6 Temmuz 2015
Mesajlar
926
Excel Vers. ve Dili
2003
Merhabalar,
Yukarıda arkadaşlar cevap vermişler ama bende kendi anladığım kadarıyla cevap vereyim dedim.
Dilerim işinizi görür. Hayırlı bayramlar...

Renk.xlsm dosyasını indir - download

Renk.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle
www.dosya.tc www.dosya.tc
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
cicosz' Alıntı:
Merhaba,

Belirttiğiniz aralıkların her birisi için dolu hücre sayısını alıp, bu sayıyı o aralıktaki hücre sayısıyla karşılaştırdım.

n1 den örnek verecek olursak;
E5:E9 aralığında 5 hücre yer almaktadır. Sizin isteğiniz de aralıktaki en az bir hücre boşsa o aralığı yeşil renkle dolgu yapmak şeklindeydi. ( "en az bir hücre dolu değilse" dediğinizi ben en az bir hücre boşsa şeklinde yorumladım ). SpecialCells(xlCellTypeConstants).Count kısmı ile dolu hücreleri saydırdım. Dolayısıyla E5:E9 arasındaki dolu hücre sayısı 5 ten küçükse o aralığı yeşil dolgu yaptım. Else kısmında ise aralıktaki hücrelerin tamamı doluysa dolguyu kaldırdım.
Genişletmek için tıkla ...
Sayın @cicosz malesef olmamış diğer arkadaşların yaptıkları da olmamış.

Kural Şu:
E10 E15 arasında en az bir hücre dolu değilse E10 E15 arası yeşil olsun.

VERİ ALANI 1, 2 veya 3 te
E20 E30 arasında en az bir hücre dolu değilse E20 E30 arası yeşil olsun.

VERİ ALANI 1, 2 veya 3 te
E5 E9 arasında en az bir hücre dolu değilse E5 E9 arası yeşil olsun.

VERİ ALANI 1, 2 veya 3 te
E45 hücresi dolu değilse E45 yeşil olsun.

sayfa tıklandığı andan itibaren kurala göre renklenmesi lazım Ektra tıklamak için düğme olmayacak.

Private Sub Worksheet_Change(ByVal Target As Range) başlığı altında olması mantıklı değil mi
 
C

cicosz

Katılım
30 Mart 2010
Mesajlar
240
Excel Vers. ve Dili
2007,2010,2013
Altın Üyelik Bitiş Tarihi
29-05-2021
Merhaba,
Ne yazıkki sorunu anlayamadım. Rica etsem temsili bir çalışma kitabı hazırlayıp onun içerisinde ilgili hücreleri örneklerle açıklayabilir misiniz? Biz de orada anlattıklarınızı koda dökelim.
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Ekli dosyanın BOŞ FORM sayfası kısmında yeşil olması gereken alanları düzenleyip yeniden oluşturdum. ÖRNEK sayfasında da yeşil anlardan bazılarına bir karekter girince beyaz yapıp olması gereken renk olan beyaza çevirdim. Kısacası ÖRNEK sayfasındaki şekliyle olması gerekiyor.
Harici Link
 

Ekli dosyalar

C

cicosz

Katılım
30 Mart 2010
Mesajlar
240
Excel Vers. ve Dili
2007,2010,2013
Altın Üyelik Bitiş Tarihi
29-05-2021
Merhaba,

Dosyayı dener misiniz? Doğru çalışırsa kodları kısaltabiliriz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("E10:E61"), Target) Is Nothing Then
On Error Resume Next
ActiveSheet.Range("E10:E12,E15:E17,E21:E24,E28:E32,E35,E40:E54,E59:E61").Interior.Color = vbGreen

    n1 = ActiveSheet.Range("E10:E12").Cells.SpecialCells(xlCellTypeConstants).Count
        If n1 > 0 Then
        ActiveSheet.Range("E10:E12").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E10:E12").Interior.Color = vbGreen
        End If
    n2 = ActiveSheet.Range("E15:E17").Cells.SpecialCells(xlCellTypeConstants).Count
        If n2 > 0 Then
        ActiveSheet.Range("E15:E17").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E15:E17").Interior.Color = vbGreen
        End If
    n3 = ActiveSheet.Range("E21:E24").Cells.SpecialCells(xlCellTypeConstants).Count
        If n3 > 0 Then
        ActiveSheet.Range("E21:E24").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E21:E24").Interior.Color = vbGreen
        End If
    n4 = ActiveSheet.Range("E28:E32").Cells.SpecialCells(xlCellTypeConstants).Count
        If n4 > 0 Then
        ActiveSheet.Range("E28:E32").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E28:E32").Interior.Color = vbGreen
        End If
    n5 = ActiveSheet.Range("E35").Cells.SpecialCells(xlCellTypeConstants).Count
        If n5 > 0 Then
        ActiveSheet.Range("E35").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E35").Interior.Color = vbGreen
        End If
    n6 = ActiveSheet.Range("E40:E54").Cells.SpecialCells(xlCellTypeConstants).Count
        If n6 > 0 Then
        ActiveSheet.Range("E40:E54").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E40:E54").Interior.Color = vbGreen
        End If
    n7 = ActiveSheet.Range("E59:E61").Cells.SpecialCells(xlCellTypeConstants).Count
        If n7 > 0 Then
        ActiveSheet.Range("E59:E61").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E59:E61").Interior.Color = vbGreen
        End If
On Error GoTo 0
End If

End Sub
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,747
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Alternatif,

"BOŞ FORM" isimli sayfanızın kod bölümüne uygulayıp deneyiniz.

C++: 
Option Explicit

Private Sub Worksheet_Activate()
    Dim Alan As Range
    
    Range("E10:E12,E15:E17,E21:E24,E28:E32,E35,E40:E54,E59:E61").Interior.ColorIndex = 43
    
    If WorksheetFunction.CountA(Range("E10:E12")) > 0 Then
        Range("E10:E12").Interior.ColorIndex = xlNone
    End If

    For Each Alan In Range("E15:E17")
        If Alan.Value <> " " And Alan.Value <> "" Then Range("E15:E17").Interior.ColorIndex = xlNone
    Next
    
    If WorksheetFunction.CountA(Range("E21:E24")) > 0 Then
        Range("E21:E24").Interior.ColorIndex = xlNone
    End If
    
    If WorksheetFunction.CountA(Range("E28:E32")) > 0 Then
        Range("E28:E32").Interior.ColorIndex = xlNone
    End If
    
    If WorksheetFunction.CountA(Range("E35")) > 0 Then
        Range("E35").Interior.ColorIndex = xlNone
    End If
    
    If WorksheetFunction.CountA(Range("E40:E54")) > 0 Then
        Range("E40:E54").Interior.ColorIndex = xlNone
    End If
    
    If WorksheetFunction.CountA(Range("E59:E61")) > 0 Then
        Range("E59:E61").Interior.ColorIndex = xlNone
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Call Worksheet_Activate
End Sub
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
Korhan Ayhan' Alıntı:
Alternatif,

"BOŞ FORM" isimli sayfanızın kod bölümüne uygulayıp deneyiniz.

C++: 
Option Explicit

Private Sub Worksheet_Activate()
    Dim Alan As Range
   
    Range("E10:E12,E15:E17,E21:E24,E28:E32,E35,E40:E54,E59:E61").Interior.ColorIndex = 43
   
    If WorksheetFunction.CountA(Range("E10:E12")) > 0 Then
        Range("E10:E12").Interior.ColorIndex = xlNone
    End If

    For Each Alan In Range("E15:E17")
        If Alan.Value <> " " And Alan.Value <> "" Then Range("E15:E17").Interior.ColorIndex = xlNone
    Next
   
    If WorksheetFunction.CountA(Range("E21:E24")) > 0 Then
        Range("E21:E24").Interior.ColorIndex = xlNone
    End If
   
    If WorksheetFunction.CountA(Range("E28:E32")) > 0 Then
        Range("E28:E32").Interior.ColorIndex = xlNone
    End If
   
    If WorksheetFunction.CountA(Range("E35")) > 0 Then
        Range("E35").Interior.ColorIndex = xlNone
    End If
   
    If WorksheetFunction.CountA(Range("E40:E54")) > 0 Then
        Range("E40:E54").Interior.ColorIndex = xlNone
    End If
   
    If WorksheetFunction.CountA(Range("E59:E61")) > 0 Then
        Range("E59:E61").Interior.ColorIndex = xlNone
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Call Worksheet_Activate
End Sub
Genişletmek için tıkla ...
Sayın @Korhan Ayhan malesef kod 1004 hatası verdi. Application defined or object -defined error hatası verdi
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
cicosz' Alıntı:
Merhaba,

Dosyayı dener misiniz? Doğru çalışırsa kodları kısaltabiliriz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("E10:E61"), Target) Is Nothing Then
On Error Resume Next
ActiveSheet.Range("E10:E12,E15:E17,E21:E24,E28:E32,E35,E40:E54,E59:E61").Interior.Color = vbGreen

    n1 = ActiveSheet.Range("E10:E12").Cells.SpecialCells(xlCellTypeConstants).Count
        If n1 > 0 Then
        ActiveSheet.Range("E10:E12").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E10:E12").Interior.Color = vbGreen
        End If
    n2 = ActiveSheet.Range("E15:E17").Cells.SpecialCells(xlCellTypeConstants).Count
        If n2 > 0 Then
        ActiveSheet.Range("E15:E17").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E15:E17").Interior.Color = vbGreen
        End If
    n3 = ActiveSheet.Range("E21:E24").Cells.SpecialCells(xlCellTypeConstants).Count
        If n3 > 0 Then
        ActiveSheet.Range("E21:E24").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E21:E24").Interior.Color = vbGreen
        End If
    n4 = ActiveSheet.Range("E28:E32").Cells.SpecialCells(xlCellTypeConstants).Count
        If n4 > 0 Then
        ActiveSheet.Range("E28:E32").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E28:E32").Interior.Color = vbGreen
        End If
    n5 = ActiveSheet.Range("E35").Cells.SpecialCells(xlCellTypeConstants).Count
        If n5 > 0 Then
        ActiveSheet.Range("E35").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E35").Interior.Color = vbGreen
        End If
    n6 = ActiveSheet.Range("E40:E54").Cells.SpecialCells(xlCellTypeConstants).Count
        If n6 > 0 Then
        ActiveSheet.Range("E40:E54").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E40:E54").Interior.Color = vbGreen
        End If
    n7 = ActiveSheet.Range("E59:E61").Cells.SpecialCells(xlCellTypeConstants).Count
        If n7 > 0 Then
        ActiveSheet.Range("E59:E61").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E59:E61").Interior.Color = vbGreen
        End If
On Error GoTo 0
End If

End Sub
Genişletmek için tıkla ...
Sayın @cicosz dosya çalışıyor ama
Ben veri doğrulama yolu ile veri çektiğim için veri doğrulama yolu ile açılır pencereden veri seçince yeşil beyaza dönmüyor.
Bir de ben arka fonda kılavuz çizgisi olmadan sadece beyaz olsun arka renk
 
C

cicosz

Katılım
30 Mart 2010
Mesajlar
240
Excel Vers. ve Dili
2007,2010,2013
Altın Üyelik Bitiş Tarihi
29-05-2021
Merhaba,

@Korhan Ayhan 'ın kod dizisinin bir de bu versiyonunu dener misiniz?

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("E10:E61"), Target) Is Nothing Then
On Error Resume Next
ActiveSheet.Range("E10:E12,E15:E17,E21:E24,E28:E32,E35,E40:E54,E59:E61").Interior.Color = vbGreen

    If WorksheetFunction.CountA(Range("E10:E12")) > 0 Then
        ActiveSheet.Range("E10:E12").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E10:E12").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E15:E17")) > 0 Then
        ActiveSheet.Range("E15:E17").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E15:E17").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E21:E24")) > 0 Then
        ActiveSheet.Range("E21:E24").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E21:E24").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E28:E32")) > 0 Then
        ActiveSheet.Range("E28:E32").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E28:E32").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E35")) > 0 Then
        ActiveSheet.Range("E35").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E35").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E40:E54")) > 0 Then
        ActiveSheet.Range("E40:E54").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E40:E54").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E59:E61")) > 0 Then
        ActiveSheet.Range("E59:E61").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E59:E61").Interior.Color = vbGreen
        End If
On Error GoTo 0
End If

End Sub
 
T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
744
Excel Vers. ve Dili
2016 64 TR
Altın Üyelik Bitiş Tarihi
29-10-2026
cicosz' Alıntı:
Merhaba,

@Korhan Ayhan 'ın kod dizisinin bir de bu versiyonunu dener misiniz?

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Range("E10:E61"), Target) Is Nothing Then
On Error Resume Next
ActiveSheet.Range("E10:E12,E15:E17,E21:E24,E28:E32,E35,E40:E54,E59:E61").Interior.Color = vbGreen

    If WorksheetFunction.CountA(Range("E10:E12")) > 0 Then
        ActiveSheet.Range("E10:E12").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E10:E12").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E15:E17")) > 0 Then
        ActiveSheet.Range("E15:E17").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E15:E17").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E21:E24")) > 0 Then
        ActiveSheet.Range("E21:E24").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E21:E24").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E28:E32")) > 0 Then
        ActiveSheet.Range("E28:E32").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E28:E32").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E35")) > 0 Then
        ActiveSheet.Range("E35").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E35").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E40:E54")) > 0 Then
        ActiveSheet.Range("E40:E54").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E40:E54").Interior.Color = vbGreen
        End If
    If WorksheetFunction.CountA(Range("E59:E61")) > 0 Then
        ActiveSheet.Range("E59:E61").Interior.ColorIndex = xlNone
        Else
        ActiveSheet.Range("E59:E61").Interior.Color = vbGreen
        End If
On Error GoTo 0
End If

End Sub
Genişletmek için tıkla ...
Malesef olmadı sizin kod oldu ama onda da veri doğrulamadan veri seçince malesef renk yeşilde kalıyor
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst