[Yardım]  Boş Hücrelerin Renklenmesi

Kulanıcı arayüz formu

Boş Hücrelerin Renklenmesi

İleti#1)  selimileri0623 » 17 Tem 2020 14:51

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 eta 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 .
Kullanıcı avatarı
selimileri0623
Siteye Alışmış
 
Kayıt: 18 Ağu 2019 10:27
Meslek: Işçi
Yaş: 38
İleti: 230
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: MERSIN

Cevap: Boş Hücrelerin Renklenmesi

İleti#2)  OmerFaruk72 » 17 Tem 2020 16:24

Koşullu biçimlendirme ile rahatlıkla yapabilirsiniz. Biraz denemye çalışın
Kullanıcı avatarı
OmerFaruk72
Siteye Alışmış
 
Kayıt: 15 Ekm 2018 10:39
Meslek: Elektrik Mühendisi
Yaş: 48
İleti: 253
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara/Çankaya

Cevap: Cevap: Boş Hücrelerin Renklenmesi

İleti#3)  selimileri0623 » 01 Ağu 2020 17:31

OmerFaruk72 yazdı:Koşullu biçimlendirme ile rahatlıkla yapabilirsiniz. Biraz denemye çalışın

Kod: Tümünü seç
     
Private Sub Worksheet_Change(ByVal Target As Range)
Dim VERİ ALANI 1, VERİ ALANI 2, VERİ ALANI 3 Worksheet
    If Range("E5:E9") = " " Then
        Range("E5:E9").Interior.Color = vbYellow
    End If

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


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


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

End Sub   
   



Yanlız sorun şu: misal E20 E30 arasındaki aralıktaki bir hücrede bile bir karekter yazılı ise E20 E30 arası yeşil olmasın normal beyaz görünsün bunu yapamadım.
Kullanıcı avatarı
selimileri0623
Siteye Alışmış
 
Kayıt: 18 Ağu 2019 10:27
Meslek: Işçi
Yaş: 38
İleti: 230
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: MERSIN

Cevap: Boş Hücrelerin Renklenmesi

İleti#4)  feraz » 01 Ağu 2020 23:10

Alttaki kod functiona çevirilipte diğer hücrelere uygulanabilir kısaca.

Kod: Tümünü seç
Var = 0
For i = 20 To 30
    If Trim(Cells(i, "E").Value) <> "" Then
        Var = 1
        Exit For
    End If
Next
Range("E20").Resize(11, 1).Interior.Color = vbYellow
If Var = 1 Then Range("E20").Resize(11, 1).Interior.Color = xlNone
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Boş Hücrelerin Renklenmesi

İleti#5)  feraz » 01 Ağu 2020 23:17

Kod: Tümünü seç
Private Sub CommandButton1_Click()
    Call Renk(5, 9)
    Call Renk(10, 15)
    Call Renk(20, 30)
End Sub


Kod: Tümünü seç
Sub Renk(bas As Integer, son As Integer)
    Dim var As Byte
    var = 0
    For i = bas To son
        If Trim(Cells(i, "E").Value) <> "" Then
            var = 1
            Exit For
        End If
    Next
    Range("E" & bas & ":E" & son).Interior.Color = vbYellow
    If var = 1 Then Range("E" & bas & ":E" & son).Interior.Color = xlNone
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#6)  selimileri0623 » 01 Ağu 2020 23:36

Zafer Hocam Merhaba 5. Mesajda yazdığınız kod buton yardımı e çalışıyor sanırım.
Ama benim ihtiyacım aralıkta boş olunca görmeden yazdırıp basıyorum sayfayı.
Yanı sayfaya girdiğimde verilen aralıklarda en az bir karekter yoksa yeşil olup renk yardımı ile beni uyarsın istiyorum. 5. Mesajdaki kodları dosyaya nasıl uygulayacağımı açıkçası pek beceredim .
Kullanıcı avatarı
selimileri0623
Siteye Alışmış
 
Kayıt: 18 Ağu 2019 10:27
Meslek: Işçi
Yaş: 38
İleti: 230
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: MERSIN

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Boş Hücrelerin Renklenmesi

İleti#7)  feraz » 01 Ağu 2020 23:59

Alttakini bir dene abey,tam anladımmı bilemiyorum mantık hatası olabilir.
Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range)
    If (Target.Row >= 5 And Target.Row <= 9) And Target.Column = 5 Then
        If WorksheetFunction.CountA([E5:E9]) > 0 Then
            [E5:E9].Interior.Color = vbYellow
        Else
            [E5:E9].Interior.Color = xlNone
        End If
    End If
    '---------------------------------------------------------------------
    If (Target.Row >= 10 And Target.Row <= 15) And Target.Column = 5 Then
        If WorksheetFunction.CountA([E10:E15]) > 0 Then
            [E10:E15].Interior.Color = vbYellow
        Else
            [E10:E15].Interior.Color = xlNone
        End If
    End If
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#8)  feraz » 02 Ağu 2020 00:01

Kod: Tümünü seç
Private Sub Worksheet_Change(ByVal Target As Range)
    If (Target.Row >= 5 And Target.Row <= 9) And Target.Column = 5 Then
        If WorksheetFunction.CountA([E5:E9]) > 0 Then
            [E5:E9].Interior.Color = xlNone
        Else
            [E5:E9].Interior.Color = vbGreen
        End If
    End If
    '---------------------------------------------------------------------
    If (Target.Row >= 10 And Target.Row <= 15) And Target.Column = 5 Then
        If WorksheetFunction.CountA([E10:E15]) > 0 Then
            [E10:E15].Interior.Color = xlNone
        Else
            [E10:E15].Interior.Color = vbGreen
        End If
    End If
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#9)  feraz » 02 Ağu 2020 00:19

Buda kodları kısaltmak için.
Kod: Tümünü seç
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


Kod: Tümünü seç
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
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#10)  feraz » 02 Ağu 2020 00:28

So kodu kullanacaksanız ilgili kodu alttaki ile değiştirin. Set alan = Nothing ekledim.Bunu eklemeyince E50:E80 aralığında denedim E500 e kadar kod aldı başını gitti renk olarak :)

Kod: Tümünü seç
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
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#11)  feraz » 02 Ağu 2020 00:32

Kodun çalışmasıda alttaki resimdeki gibi.

Resim
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#12)  selimileri0623 » 04 Ağu 2020 21:27

Hocam malesef bu şekilde işimi görmedi.
Kullanıcı avatarı
selimileri0623
Siteye Alışmış
 
Kayıt: 18 Ağu 2019 10:27
Meslek: Işçi
Yaş: 38
İleti: 230
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: MERSIN

Cevap: Boş Hücrelerin Renklenmesi

İleti#13)  feraz » 04 Ağu 2020 22:17

Dosyanızı ekleyin bakalım.Sonunuza göre gifteki gibi çözüm oldu gibi.

Belki kodu uygulayamadınız.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#14)  selimileri0623 » 04 Ağu 2020 23:11

[url]https://dosya.co/y8l1fe6dap5u/taslak.xlsx.html
[/url]
Hocam linkte örnek dosyam mevcut
Kullanıcı avatarı
selimileri0623
Siteye Alışmış
 
Kayıt: 18 Ağu 2019 10:27
Meslek: Işçi
Yaş: 38
İleti: 230
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: MERSIN

Cevap: Boş Hücrelerin Renklenmesi

İleti#15)  selimileri0623 » 04 Ağu 2020 23:12

Kullanıcı avatarı
selimileri0623
Siteye Alışmış
 
Kayıt: 18 Ağu 2019 10:27
Meslek: Işçi
Yaş: 38
İleti: 230
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: MERSIN

Cevap: Boş Hücrelerin Renklenmesi

İleti#16)  feraz » 05 Ağu 2020 00:45

Merhaba.
Kodları biraz değiştirdim koaylık olsun diye.Sayfa aktif olunca ve veri değişince kod çalışır.
Yapmanız gerekenler;
arr = Array("E10:E12", "E15:E17", "E21:E24", "E28:E32", "E35:E35", "E39:E54", "E59:E61")
buraya ekleme yaparsanız Renk Range(arr(0)), Target.Row, Target.Column 'arr(0)= "E10:E12" burayada ekleme yapmalısınız.
Kısaca array yazan yer ve Worksheet_Change .ç.nceki kodu ayarlayacaksınız zor değil.

BOŞ FORM adındaki sayfa için kod yazdım aynısını diğer sayfalarada uygulayabilirsiniz.
Kod: Tümünü seç
Dim arr

Private Sub Worksheet_Change(ByVal Target As Range)
    'Alta ekleme yapilabilir
    Renk Range(arr(0)), Target.Row, Target.Column 'arr(0)= "E10:E12"
    Renk Range(arr(1)), Target.Row, Target.Column
    Renk Range(arr(2)), Target.Row, Target.Column
    Renk Range(arr(3)), Target.Row, Target.Column
    Renk Range(arr(4)), Target.Row, Target.Column
    Renk Range(arr(5)), Target.Row, Target.Column
    Renk Range(arr(6)), Target.Row, Target.Column 'arr(6)= "E59:E61"
End Sub

Sub Renk(alan As Range, aktifSatir As Integer, aktifSutun As Byte) 'Sayfadaki veri degisince
    Dim basSay As String, sonSay As String, i As Integer, ilkSatir As Integer, sonsatir As Integer, varmi As Integer

    varmi = InStr(1, alan.Address(0, 0), ":")
    If varmi = 0 Then
        basSay = Mid(alan.Address(0, 0), 1, Len(alan.Address))
        sonSay = Mid(alan.Address(0, 0), 1, Len(alan.Address))
    ElseIf varmi > 0 Then
        basSay = Mid(alan.Address(0, 0), 1, InStr(1, alan.Address(0, 0), ":") - 1)
        sonSay = Mid(alan.Address(0, 0), InStrRev(alan.Address(0, 0), ":") + 1, Len(alan.Address))
    End If

    For i = 1 To Len(basSay)
        If IsNumeric(Mid(basSay, i, 1)) Then ilkSatir = ilkSatir & Mid(basSay, i, 1)
    Next

    For i = 1 To Len(sonSay)
        If IsNumeric(Mid(sonSay, i, 1)) Then sonsatir = sonsatir & Mid(sonSay, i, 1)
    Next

    If (aktifSatir >= ilkSatir And aktifSatir <= sonsatir) 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


Kod: Tümünü seç
Private Sub Worksheet_Activate()
    arr = Array("E10:E12", "E15:E17", "E21:E24", "E28:E32", "E35:E35", "E39:E54", "E59:E61")
       
    For Each xyz In arr
        If WorksheetFunction.CountA(Range(xyz)) > 0 Then
            Range(xyz).Interior.Color = xlNone
        Else
            Range(xyz).Interior.Color = vbGreen
        End If
    Next
End Sub


Kod: Tümünü seç
Private Sub Worksheet_Deactivate()
    Erase arr
End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#17)  feraz » 05 Ağu 2020 00:59

Önceki mesajda change kodlarını pasif olarak unutmuşum.
Gerçi o dosyayı unutun alttaki kodları deneyin.

Yapmanız gereken tek şey arr = Array("E10:E12", "E15:E17", "E21:E24", "E28:E32", "E35:E35", "E39:E54", "E59:E61")
burdaki ayarları değiştirmrniz yada eklemeniz.

Kod: Tümünü seç
Dim arr()

Sub arrayyy()
    arr = Array("E10:E12", "E15:E17", "E21:E24", "E28:E32", "E35:E35", "E39:E54", "E59:E61")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
     arrayyy
     For Each xyz In arr
          Renk Range(xyz), Target.Row, Target.Column
      Next
End Sub

Sub Renk(alan As Range, aktifSatir As Integer, aktifSutun As Byte) 'Sayfadaki veri degisince
    Dim basSay As String, sonSay As String, i As Integer, ilkSatir As Integer, sonsatir As Integer, varmi As Integer

    varmi = InStr(1, alan.Address(0, 0), ":")
    If varmi = 0 Then
        basSay = Mid(alan.Address(0, 0), 1, Len(alan.Address))
        sonSay = Mid(alan.Address(0, 0), 1, Len(alan.Address))
    ElseIf varmi > 0 Then
        basSay = Mid(alan.Address(0, 0), 1, InStr(1, alan.Address(0, 0), ":") - 1)
        sonSay = Mid(alan.Address(0, 0), InStrRev(alan.Address(0, 0), ":") + 1, Len(alan.Address))
    End If

    For i = 1 To Len(basSay)
        If IsNumeric(Mid(basSay, i, 1)) Then ilkSatir = ilkSatir & Mid(basSay, i, 1)
    Next

    For i = 1 To Len(sonSay)
        If IsNumeric(Mid(sonSay, i, 1)) Then sonsatir = sonsatir & Mid(sonSay, i, 1)
    Next

    If (aktifSatir >= ilkSatir And aktifSatir <= sonsatir) 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
'--------------------------------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Activate()
    arrayyy
    For Each xyz In arr
        If WorksheetFunction.CountA(Range(xyz)) > 0 Then
            Range(xyz).Interior.Color = xlNone
        Else
            Range(xyz).Interior.Color = vbGreen
        End If
    Next
End Sub

Private Sub Worksheet_Deactivate()
    Erase arr
End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#18)  selimileri0623 » 05 Ağu 2020 08:41

Hocam sizdeki dosya çalışıyor.
Ama ben veri doğrulama yöntemi yöntemi ile veri çektiğinden hata verdi

malesef kod 1004 hatası verdi. Application defined or object -defined error hatası verdi
Kullanıcı avatarı
selimileri0623
Siteye Alışmış
 
Kayıt: 18 Ağu 2019 10:27
Meslek: Işçi
Yaş: 38
İleti: 230
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: MERSIN

Cevap: Boş Hücrelerin Renklenmesi

İleti#19)  feraz » 05 Ağu 2020 10:07

Nerde yapıyorsunuz veri doğrulamayı?

Hatalı dosyayı yollayın bakalum neden kaynaklanıyormuş.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 17:36
Konum: Almanya
Meslek: İşçi
Yaş: 41
İleti: 6249
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Boş Hücrelerin Renklenmesi

İleti#20)  selimileri0623 » 05 Ağu 2020 12:57

Hocam aynı kitapta VERİ GİRİŞİ adlı sayfadan veri çekmek sureti ile (açılır veri doğrulama yöntemi ile ) yapıyorum. Orjinal dosyada kimlik no vb bilgi olduğundan su an için atamıyorum
Kullanıcı avatarı
selimileri0623
Siteye Alışmış
 
Kayıt: 18 Ağu 2019 10:27
Meslek: Işçi
Yaş: 38
İleti: 230
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: MERSIN

Sonraki

Forum UserForm

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

Bumerang - Yazarkafe