• DİKKAT

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

Hücreye Aynı Değer Girilirse Hücrenin Eğri Siyah Yapılması

Merhaba;
Eklediğiniz örnek dosyanızın "DATA" Sayfasının sekmesine sağ tıklayarak "Kod Görüntüle" seçeneğine tıklayınız. Açılan kod penceresine, aşağıdaki kodların tümünü kopyalayıp yapıştırınız:
Kod: 
Dim mevcut As Long, deg As Long, hcr As Range
Private Sub Worksheet_Change(ByVal Target As Range)
deg = Target.Value

If deg = mevcut Then
   With hcr
        .Font.Size = 18
        .Font.Italic = True
        .Font.Bold = True
   End With
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set hcr = ActiveSheet.Range("D6")
mevcut = ActiveSheet.Range("D6").Value
End Sub
 
Merhaba.

Aklıma gelen çözüm aşağıdaki gibi olabilir.

► Aynı hücreye aynı değerin yazılması:
Aslında bu tür işlemleri belgelerde kullanmayı ben pek tercih etmem, tabi tercih sizin.
Malesef, makro çalışacağı için GERİAL işlevi kullanılamaz hale geliyor.

-- alt taraftan uygulama istediğiniz sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- açılan VBA ekranında sağdaki boş alana aşağıdaki kod'ları yapıştırın.

A1 hücresinen işlemlerde kullanılmadığı varsayılmıştır.
(A1 hücresi gerekli ise kod'lardaki A1 yerine kullanmayacağınız bir hücrenin adresini yazın)
.
Kod: 
[B][COLOR="Blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/B]
If Target = [[B][COLOR="Red"]A1[/COLOR][/B]] Then
    With Target
        .Font.Color = vbBlack: .Font.Size = 18: .Font.Italic = True
    End With
End If
[B][COLOR="Blue"]End Sub[/COLOR][/B]

[B][COLOR="Blue"]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/COLOR][/B]
    [[B][COLOR="Red"]A1[/COLOR][/B]] = Target
[B][COLOR="Blue"]End Sub[/COLOR][/B]
► Farklı hücreye aynı değerin yazılması:
KOŞULLU BİÇİMLENDİRME menüsünde FORMÜL KULLAN seçeneğinde aşağıdaki formülü uygulayıp
ZEMİN RENGİ olarak dikkat çekici bir RENK seçin, UYGULAMA HEDEFİ kısmına da
=$1:$65536 yazın ve işlemi onaylayın.
Böylece başka bir hücreye daha evvel yazılan bir değer yazılırsa KOŞULLU BİÇİMLENDİRME sayesinde zemin rengi boyanacaktır.
Eğer yukarıdaki kod'u kullanacaksanız aşağıdaki formülde yer alan >1 kısmını >2 olarak değiştirin.

Buradaki tavsiyem ise alan daraltmanız yönünde olacak.
.
Kod: 
=[COLOR="red"]VE[/COLOR](A1<>"";[COLOR="Red"]EĞERSAY[/COLOR]($1:$65536;A1)>1)
 
Sayın Antonio, Sayın Ömer Baran yardımlarınızı ve emeğiniz için çok teşekkür ediyorum. Allah sizlerden razı olsun. Sağlıcakla kalın.
 
Ömer Baran üstadım. Kodun sadece B2:F10 alanında çalışmasını sağlanması mümkün mü ?
 
Verdiğim kod'u aşağıdakiyle değiştirin.
Belirttiğiniz hücre aralığında işlem yaptığınızda, GERİ AL işlevinin çalışmayacağını yine hatırlatmak istiyorum.
A1 hücresinin biçimini, belirttiğiniz B2:F10 aralığında kullandığınız genel yazıtipi rengi ve boyutuna uygun olarak biçimlendirin.
.
Kod: 
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [[COLOR="Red"]B2:F10[/COLOR]]) Is Nothing Then Exit Sub
    With Target
        If Target = [A1] Then
            .Font.Color = vbBlack: .Font.Size = 18: .Font.Italic = True
        Else
            .Font.Color = [A1].Font.Color: .Font.Size = [A1].Font.Size: .Font.Italic = False
        End If
    End With
[B]End Sub[/B]

[B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]
If Intersect(Target, [[COLOR="red"]B2:F10[/COLOR]]) Is Nothing Then Exit Sub
[A1] = Target
[B]End Sub[/B]
 
Ömer Baran üstadım, desteğiniz ve bilgilendirme için çok teşekkürler. Emeğinize, aklınıza sağlık, sağlıcakla kalın.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst