Koşullu Biçimlendirme Gibi Bir Şey Hk. Yardım Ricası

[mozyildirim]

Selamun Aleyküm, Merhaba Arkadaşlar,

Forumu yıllardır takip ediyorum. Hali hazırda açılmış konulardan bir çok sorumun cevabını buldum. Ancak birazdan anlatacağım problemimi çözemedim. Değerli yardımlarınızı rica ederim.

Şimdi;

bir hücrede 50.000 TL yazdığını varsayalım. "bu hücrenin dolgu rengi sarı, yazı rengi kırmızı, bold ve italik ise yanındaki hücreye 2ND yazsın, Sadece dolgu rengi sarı ise LEAS yazsın, hücre boş olunca boş bıraksın" gibi bir biçimlendirmeyi nasıl yapabiliriz?

Değerli zamanınızı ayırıp yardımcı olduğunuz için teşekkür ederim.

 

[yanginci34]

Selamun Aleyküm, Merhaba Arkadaşlar,

Forumu yıllardır takip ediyorum. Hali hazırda açılmış konulardan bir çok sorumun cevabını buldum. Ancak birazdan anlatacağım problemimi çözemedim. Değerli yardımlarınızı rica ederim.

Şimdi;

bir hücrede 50.000 TL yazdığını varsayalım. "bu hücrenin dolgu rengi sarı, yazı rengi kırmızı, bold ve italik ise yanındaki hücreye 2ND yazsın, Sadece dolgu rengi sarı ise LEAS yazsın, hücre boş olunca boş bıraksın" gibi bir biçimlendirmeyi nasıl yapabiliriz?

Değerli zamanınızı ayırıp yardımcı olduğunuz için teşekkür ederim.

Merhaba; Sadece dolgu rengi sarı derken içinde değer varmı? Boş oluncaderken? Butip soruları daha sonra sormamak için örnek bir dosya yüklermisiniz.

 

[mozyildirim]

Merhaba; Sadece dolgu rengi sarı derken içinde değer varmı? Boş oluncaderken? Butip soruları daha sonra sormamak için örnek bir dosya yüklermisiniz.

Hocam,

Bu şekilde yükleyebildim. Umarım sorun olmaz.

http://s3.dosya.tc/server11/425ag6/Kitap2.xlsx.html

 

[systran]

mevcut sayfadaki, A sütundaki verileri son satıra kadar kontrol eder.

Sub rengegöreyaz()
Application.ScreenUpdating=false
ss = Range("A1048576").End(xlUp).Row
Dim cl As Range
For Each cl In Range("A1:A" & ss)
    If Not (IsEmpty(cl)) Then
        dolgurenk = (cl.Interior.Color) = 65535 'SARI 65535
        yazırenk = (cl.Font.Color) = 255      'KIRMIZI 255
        kalın = (cl.Font.Bold) = True
        italik = (cl.Font.Italic) = True
        
        If (dolgurenk And yazırenk And kalın And italik) Then
            Cells(cl.Row, cl.Column + 1) = "2ND"
        ElseIf (dolgurenk) Then
            Cells(cl.Row, cl.Column + 1) = "LEAS"
        Else
        
        End If
        
    End If
Next
Application.ScreenUpdating=True
End Sub

 

[mozyildirim]

mevcut sayfadaki, A sütundaki verileri son satıra kadar kontrol eder.

Sub rengegöreyaz()
Application.ScreenUpdating=false
ss = Range("A1048576").End(xlUp).Row
Dim cl As Range
For Each cl In Range("A1:A" & ss)
    If Not (IsEmpty(cl)) Then
        dolgurenk = (cl.Interior.Color) = 65535 'SARI 65535
        yazırenk = (cl.Font.Color) = 255      'KIRMIZI 255
        kalın = (cl.Font.Bold) = True
        italik = (cl.Font.Italic) = True
        
        If (dolgurenk And yazırenk And kalın And italik) Then
            Cells(cl.Row, cl.Column + 1) = "2ND"
        ElseIf (dolgurenk) Then
            Cells(cl.Row, cl.Column + 1) = "LEAS"
        Else
        
        End If
        
    End If
Next
Application.ScreenUpdating=True
End Sub

Sayın systran Hocam,

Yanıtınız problemimizi çözdü. Teşekkür ederim. Kendimce şu şekilde ekleme yaptım. Yol, yordam gösterip yardım ettiğiniz için çok minnettarım.

Saygılar,

Sub RENGE_GÖRE_YAZ()

ss = Range("N223").End(xlUp).Row
Dim cl As Range
For Each cl In Range("N24:N223" & ss)
    If Not (IsEmpty(cl)) Then
        dolgurenk = (cl.Interior.Color) = 65535 'SARI 65535
        yazırenk = (cl.Font.Color) = 255      'KIRMIZI 255
        kalın = (cl.Font.Bold) = True
        italik = (cl.Font.Italic) = True
        
        If (dolgurenk And yazırenk And kalın And italik) Then
            Cells(cl.Row, cl.Column + 1) = "2ND"
        ElseIf (dolgurenk And yazırenk And kalın) Then
            Cells(cl.Row, cl.Column + 1) = "CRTEMP"
        ElseIf (dolgurenk And italik And kalın) Then
            Cells(cl.Row, cl.Column + 1) = "INSREC"
        ElseIf (dolgurenk And kalın) Then
            Cells(cl.Row, cl.Column + 1) = "TVR"
        ElseIf (dolgurenk) Then
            Cells(cl.Row, cl.Column + 1) = "LEAS"
        
            
        End If
        
    End If
Next
End Sub

 

[systran]

:bravo::bravo::bravo: