• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücre Renklendirme

B

betoncu

Katılım
1 Aralık 2005
Mesajlar
376
Excel Vers. ve Dili
EXCEL 2002
TÜRKÇE
1. C58 HÜCRESİ C25 HÜCRESİNE EŞİTSE C25 HÜCRESİNİ GÜL RENGİNDE BOYAYAN (REN KODU 38) - C58 HÜCRESİ BOŞSA C25 HÜCRESİNİN MAKRO İLE BOYANMASINI İSTEMİYORUM

2. D58 HÜCRESİ H25 HÜCRESİNE EŞİTSE H25 HÜCRESİNİ AÇIK EFLATUN RENGİNDE BOYAYAN (RENK KODU 39) - D58 HÜCRESİ BOŞSA H25 HÜCRESİNİN MAKRO İLE BOYANMASINI İSTEMİYORUM


Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan

KODA İHTİYACIM VARDIR. YARDIMLARINIZI BEKLİYORUM…..


NOT:C25 ve H25 hücrelerini koşullu biçimlendirme ile 3 koşul ile kullandığımdam bu ilave koşullar için kod ihtiyacı doğmuştur.
 
Arkadaşlar
Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan koddan ziyade bu koşulları gerçekleştirecek bir kod lazım.
 
betoncu' Alıntı:
1. C58 HÜCRESİ C25 HÜCRESİNE EŞİTSE C25 HÜCRESİNİ GÜL RENGİNDE BOYAYAN (REN KODU 38) - C58 HÜCRESİ BOŞSA C25 HÜCRESİNİN MAKRO İLE BOYANMASINI İSTEMİYORUM

2. D58 HÜCRESİ H25 HÜCRESİNE EŞİTSE H25 HÜCRESİNİ AÇIK EFLATUN RENGİNDE BOYAYAN (RENK KODU 39) - D58 HÜCRESİ BOŞSA H25 HÜCRESİNİN MAKRO İLE BOYANMASINI İSTEMİYORUM


Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan

KODA İHTİYACIM VARDIR. YARDIMLARINIZI BEKLİYORUM…..


NOT:C25 ve H25 hücrelerini koşullu biçimlendirme ile 3 koşul ile kullandığımdam bu ilave koşullar için kod ihtiyacı doğmuştur.
Genişletmek için tıkla ...
Söylediklerinizden bir şey anlamak pek mümkün olmuyor. İstemediklerinizi belirtmişsiniz istedikleriniz neler? Bir örnek dosya ekleyip isteklerinizi orada göstermeniz, daha çabuk yardım almanızı sağlayacaktır.
 
Örnek Dosya

Arkadaşlar örnek dosya ektedir.
 

Ekli dosyalar

C58 hücresi boş değil fakat C25'e eşit değil. Bu durumda ne olacak?

Kod: 
Sub int_col()

    With ActiveSheet 'veya Worksheets("SayfaAdı")
        If .Range("C58").Value = .Range("C25") Then
            .Range("C25").Interior.ColorIndex = 38
        Else
            .Range("C25").Interior.ColorIndex = xlColorIndexNone
        End If
        If .Range("D58").Value = .Range("H25") Then
            .Range("H25").Interior.ColorIndex = 39
        Else
            .Range("H25").Interior.ColorIndex = xlColorIndexNone
        End If
    End With

End Sub
 
C58 veya d58 boş değil fakat sıra ile c25 ve h25 e eşit değilse "hatalı merkez girişi" olarak formül ile uyarı veriyor. Bu durumda hücrelerin boyanmasını istemiyorum.
 
mancubus' Alıntı:
c58 hücresi boş değil fakat c25'e eşit değil. Bu durumda ne olacak?

Kod: 
sub int_col()

    with activesheet 'veya worksheets("sayfaadı")
        ıf .range("c58").value = .range("c25") then
            .range("c25").ınterior.colorındex = 38
        else
            .range("c25").ınterior.colorındex = xlcolorındexnone
        end ıf
        ıf .range("d58").value = .range("h25") then
            .range("h25").ınterior.colorındex = 39
        else
            .range("h25").ınterior.colorındex = xlcolorındexnone
        end ıf
    end with

end sub
Genişletmek için tıkla ...

bu kod makroyu çalıştırınca oluyor. Fakat makroyu çalıştırmadan olmuyor. çalışma sayfasında otomatik devreye alabilirmiyiz?
 
betoncu' Alıntı:
Arkadaşlar
Private Sub Worksheet_Change(ByVal Target As Range) ile başlayan koddan ziyade bu koşulları gerçekleştirecek bir kod lazım.
Genişletmek için tıkla ...

bu mesaja göre hazırlandı.

betoncu' Alıntı:
bu kod makroyu çalıştırınca oluyor. Fakat makroyu çalıştırmadan olmuyor. çalışma sayfasında otomatik devreye alabilirmiyiz?
Genişletmek için tıkla ...

herhangi bir "event" kodu ile olabilir. yeter ki makroyu neyin tetikleyeceği konusunda bilgi olsun.

yalnız bu veri somut olmalı.
örneğin,
- A sütununda bir hücre değeri değiştiğinde,
- Z sütununda herhangi bir hücreyi seçtiğimdi,
- veya Z45 hücresini seçtiğimde
- sayfayı aktif hale getirdiğimde
vs vs
 
Merhaba,

Sn. mancubus'a sonuna kadar katılıyorum. İfadeleriniz insanın kafasını karıştırıyor.

Bahsettiğiniz hedef hücreler değişince (C58-D58) makro çalışır.

Sayfanın kod bölümüne uygulayınız.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C58,D58")) Is Nothing Then Exit Sub
    
    On Error Resume Next
    
    If Range("C58") = Range("C25") Then
        Range("C25").Interior.ColorIndex = 38
    Else
        Range("C25").Interior.ColorIndex = xlNone
    End If
    
    If Range("D58") = Range("H25") Then
        Range("H25").Interior.ColorIndex = 39
    Else
        Range("H25").Interior.ColorIndex = xlNone
    End If
End Sub
 
korhan ayhan' Alıntı:
merhaba,

sn. Mancubus'a sonuna kadar katılıyorum. Ifadeleriniz insanın kafasını karıştırıyor.

Bahsettiğiniz hedef hücreler değişince (c58-d58) makro çalışır.

Sayfanın kod bölümüne uygulayınız.

Kod: 
private sub worksheet_change(byval target as range)
    ıf ıntersect(target, range("c58,d58")) ıs nothing then exit sub
    
    on error resume next
    
    ıf range("c58") = range("c25") then
        range("c25").ınterior.colorındex = 38
    else
        range("c25").ınterior.colorındex = xlnone
    end ıf
    
    ıf range("d58") = range("h25") then
        range("h25").ınterior.colorındex = 39
    else
        range("h25").ınterior.colorındex = xlnone
    end ıf
end sub
Genişletmek için tıkla ...

yardımlarınız için teşekkür ederim. Bu kodu uyguladığımda c58 ve d58 boş olduğunda c25 ve h25 hücreleri boyanıyor.
C58 ve d58 boş iken c25 ve h25 hücrelerinin boyanmamasını istiyorum. Nasıl yaparız acaba?
 
Merhaba,

Aşağıdaki kodu deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C58,D58")) Is Nothing Then Exit Sub
    
    On Error Resume Next
    
    If Range("C58") = "" Or Range("D58") = "" Then Exit Sub
    
    If Range("C58") = Range("C25") Then
        Range("C25").Interior.ColorIndex = 38
    Else
        Range("C25").Interior.ColorIndex = xlNone
    End If
    
    If Range("D58") = Range("H25") Then
        Range("H25").Interior.ColorIndex = 39
    Else
        Range("H25").Interior.ColorIndex = xlNone
    End If
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,

Aşağıdaki kodu deneyin.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C58,D58")) Is Nothing Then Exit Sub
    
    On Error Resume Next
    
    If Range("C58") = "" Or Range("D58") = "" Then Exit Sub
    
    If Range("C58") = Range("C25") Then
        Range("C25").Interior.ColorIndex = 38
    Else
        Range("C25").Interior.ColorIndex = xlNone
    End If
    
    If Range("D58") = Range("H25") Then
        Range("H25").Interior.ColorIndex = 39
    Else
        Range("H25").Interior.ColorIndex = xlNone
    End If
End Sub
Genişletmek için tıkla ...



Merhaba son bir sorum olacak vba penceresinde sadece bu verdiğiniz kod olacak şekilde uygulayınca çalışıyor. Fakat benim bu kodu yapıştırdığım pencerede aşağıda belirttiğim kodda var. İkisi bir yazılınca kod çalışmıyor.
Bu sayfada iki ayrı amaç için yazılmış kodları nasıl birleştiriyoruz.

VBA Penceresinin başında yazan kod aşağıdadır:

Option Explicit
'Tasarı_Aylık_Plan sayfasında çalışma planındaki İzinliler kısmını haftanın günleri için aşağıda tespit edilen renklere boyar.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Veri As Range, Sutun

If Intersect(Target, Range("Q2:Q3")) Is Nothing Then Exit Sub

Sutun = Cells(3, Columns.Count).End(1).Column

For Each Veri In Range("X3:" & Cells(3, Sutun + 5).Address(0, 0))
With Cells(6, Veri.Column).Resize(6, 1)
Veri.Font.ColorIndex = 0
Select Case Veri.Text
Case "Pazartesi": .Interior.ColorIndex = 38 'Gül
Case "Salı": .Interior.ColorIndex = 36 'Açık Sarı
Case "Çarşamba": .Interior.ColorIndex = 8 'Turkuaz
Case "Perşembe": .Interior.ColorIndex = 43 'Limon Rengi Yeşil
Case "Cuma": .Interior.ColorIndex = 39 'Açık Eflatun
Case "Cumartesi": .Interior.ColorIndex = 45 'Açık Turuncu
Case "Pazar": .Interior.ColorIndex = 15: Veri.Font.ColorIndex = 3 'Gri %25
Case Else: .Interior.ColorIndex = xlNone
End Select
End With
Next



Bu sayfaya ilave eklemek istediğim sizlerin hazırlamış olduğu kodu nasıl birleştireceğiz acaba?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst