Seçilen Alana Zemin Rengi ve * Karakteri Eklemek

[1Al2Ver]

Merhaba,

Tabloda, fare ile seçeceğim aralığa (örneğin "E72:Q94") örnekteki gibi zemin rengi ve * karakterini bir düğme ile eklemek istiyorum,

Sonrasında bu hücrelere elle veri gireceğim, ("E3:Q71" aralığındaki gibi)

Not ; "A" ve "C" sütunlarında formül vardır,

Tarihe göre "D" sütununa girilen kişi sayısı ve isimler değişkendir.

Teşekkür ederim.

 

[Korhan Ayhan]

Bu işlemin kodlarını makro kaydet yöntemi ile elde edip düzenleyebileceğinizi düşünüyorum.

 

[1Al2Ver]

Merhaba,

Makro Kaydet ile bir kod elde ettim, ancak hücre aralıklarının sabit olmaması gerekiyor,

Bu nedenle gerekli düzenlemeyi nasıl yapa bilirim ?

Teşekkür ederim.

Sub Makro1()
'
' Makro1 Makro
'

'
    Range("E72:Q94").Select
    ActiveWindow.SmallScroll Down:=-6
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Range("E72").Select
    ActiveCell.FormulaR1C1 = "*"
    Selection.AutoFill Destination:=Range("E72:Q72"), Type:=xlFillDefault
    Range("E72:Q72").Select
    Selection.AutoFill Destination:=Range("E72:Q94"), Type:=xlFillDefault
    Range("E72:Q94").Select
End Sub

 

[Necdet]

Merhaba,

Siz zaten Koşullu Biçimlendirme yapmışsınız, kod sadece seçili hücreye * koysa sonuca ulaşacaksınız.

Eğer koşullu biçimlendirme kullanmak istemezseniz aşağıdaki kodu kendinize göre uyarlayın.
Açıklama olan satırı kaldırırsanız ben X1 hücresi rengine göre renklendirme yaptım, Böylelikle renk değişikliğini değiştirmek istediğinizde doğrudan X1 hücresinin rengini değiştirmeniz yeterli olacaktır.

Sub Düğme1_Tıkla()

    Dim Hcr As Range
    
    If Selection(1).Column < 5 Then Exit Sub
    
    For Each Hcr In Selection
        With Hcr
            .Value = "*"
'            .Interior.ColorIndex = Range("X1").Interior.ColorIndex
        End With
    Next Hcr
    
End Sub

 

[Necdet]

Geç kalmışım

 

[1Al2Ver]

Sayın Necdet merhaba,

İlginiz ve çözüm için teşekkür ederim,

Sevgi ve saygılarımla.

 

[assenucler]

Sayın 1 Al2Ver,

Merhaba, dosyanız ilgimi çekti, eğer sakıncası yoksa, son şeklini ekleyebilir misiniz?
Teşekkürler ve hayırlı işler.

Saygılar,
Selim

 

[1Al2Ver]

Sayın assenucler merhaba,

Çözümlü dosya ek'tedir,

Saygılarımla.

 

[assenucler]

Sayın 1Al2Ver,

Teşekkürler ve hayırlı işler.

Saygılar,
Selim