Birleşmiş hücrelerde koşullu biçimlendirmeye bağlı aynı renk olsun

[Teknoas]

Öğrneğin A1 hücresinde yeşil renklendirme yapıldıysa h1;h2;I1;ı2 hücreleride yeşil olsun istiyorum

 

[volki_112]

Formul ile olmaz. Makro ile olur. Sayfanin kod bolumune yaziniz

Private Sub Worksheet_Change(ByVal Target As Range)

    ' A1 hücresinde bir değişiklik olup olmadığını kontrol et
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        ' A1 hücresinin iç rengini al ve belirtilen hücrelere uygula
        Range("H1:H2, I1:I2").Interior.Color = Range("A1").Interior.Color
    End If

End Sub

 

[Muzaffer Ali]

Merhaba.
Sayın Volki nin paylaştığı kod normal hücre rengine değiştiriyor.
Koşullu biçimlendirme rengine değiştirmek için aşağıdakini kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Durum As Boolean
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        On Error Resume Next
        Durum = Me.Evaluate(Target.FormatConditions(1).Formula1)
        On Error GoTo 0
        If Durum Then
            Range("H1:H2, I1:I2").Interior.Color = Target.DisplayFormat.Interior.Color
        Else
            Range("H1:H2, I1:I2").Interior.Color = 16777215
        End If
    End If
End Sub

 

[Muzaffer Ali]

Kod olmadan çözüm isterseniz A1'de bulunan koşullu biçimlendirmeyi h1;h2;I1;ı2 hücrelerine de uygulamak yeterli olacaktır.
A1'de bulunan koşulu ve varsa formülü paylaşın yardımcı olalım.

 

[Teknoas]

Bu şekilde anlatmam daha doğru olacak aslında çalışma sayfamda yapmak istediğim şey şu:

B2 hücresine şirket yazıldığında d2:d3-e2:e3 ve l2:l3 ve m2:m3ve n2:n3 ve o23 hücresinin birlşemesini istiyorum bu birinci talebim ikinci yapmak istediğimde L hücresinde tahsil edilmiştir ifadesini seçtiğimde mevcut satırın ve yeşile rengi alması(a2 ile o2 dahil arası)

g ,h, ı,j,k,l bunlarda açılır hücre var ve örneğin g2 de yer alan değere göre rengi yine değişiyor
Bunu tüm çalışma sayfasına uyguluycam

İnşallah çok karışık anlatmamışımdır kusura bakayın ekran görüntüsü atamadığım için ancak bu kadar tarif edebildim

 

[volki_112]

Bu şekilde anlatmam daha doğru olacak aslında çalışma sayfamda yapmak istediğim şey şu:

B2 hücresine şirket yazıldığında d2:d3-e2:e3 ve l2:l3 ve m2:m3ve n2:n3 ve o23 hücresinin birlşemesini istiyorum bu birinci talebim ikinci yapmak istediğimde L hücresinde tahsil edilmiştir ifadesini seçtiğimde mevcut satırın ve yeşile rengi alması(a2 ile o2 dahil arası)

g ,h, ı,j,k,l bunlarda açılır hücre var ve örneğin g2 de yer alan değere göre rengi yine değişiyor
Bunu tüm çalışma sayfasına uyguluycam

İnşallah çok karışık anlatmamışımdır kusura bakayın ekran görüntüsü atamadığım için ancak bu kadar tarif edebildim

isteklerinizi hepsi yapılabilir. Dosya olsa daha kolay olur.

dosya.tc dosya.co gibi paylaşım sitesine dosyanızı yükleyip link verebilirsiniz. Dosyanızda özel bilgiler varsa hayali veri yazarak gönderebilirsiniz.

 

[Teknoas]

isteklerinizi hepsi yapılabilir. Dosya olsa daha kolay olur.

dosya.tc dosya.co gibi paylaşım sitesine dosyanızı yükleyip link verebilirsiniz. Dosyanızda özel bilgiler varsa hayali veri yazarak gönderebilirsiniz.

https://app.filemail.com/t/WoLLwxgo

 

[Muzaffer Ali]

Merhaba.
Dosya ekte inceleyiniz.

ON_CALISMA.xlsm dosyasını indir - download

ON_CALISMA.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[Teknoas]

Teşekkür ederim .
Birşey daha sorabilir miyim.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
Target.Copy
End If
End Sub

bu formülde copy işini F1:F10000 içinde uygulamak istiyorum formüle nasıl entegre ederim.

 

[pitchoute]

Teşekkür ederim .
Birşey daha sorabilir miyim.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
Target.Copy
End If
End Sub

bu formülde copy işini F1:F10000 içinde uygulamak istiyorum formüle nasıl entegre ederim.

Merhaba,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
        Target.Copy
    ElseIf Not Intersect(Target, Range("F1:F10000")) Is Nothing Then
        Target.Copy
    End If
End Sub

 

[Teknoas]

Merhaba,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
        Target.Copy
    ElseIf Not Intersect(Target, Range("F1:F10000")) Is Nothing Then
        Target.Copy
    End If
End Sub

ELİNİZE SAĞLIK TEŞEKKÜR EDERİM

 

[Muzaffer Ali]

Bu şekilde daha kısa yapılabilir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("E1:F10000")) Is Nothing Then
        Target.Copy
    End If
End Sub

 

[Teknoas]

Bu şekilde daha kısa yapılabilir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("E1:F10000")) Is Nothing Then
        Target.Copy
    End If
End Sub

TEŞEKKÜR EDERİM.