Soru MAKRO ATAMAK

[murex4951]

Merhaba ,

Ben bu dosyada öğrenci ismi yazdığımda sarı olarak boyamasını istiyorum,makro olarak yapılabilir mi?

 

[netzone]

Merhaba,

Öğrenci ismini nereye yazacaksınız, hangi sayfadaki isimler neye göre sarı boyanacak?
Bilgi verirseniz yapılır neden olmasın.

 

[murex4951]

A1 e olabilir

Satır ekleyip
İsimler öğrenci ismine göre ama listede olmayan isimde eklenebilir,yani sonradan isim eklenebilir

 

[netzone]

Dosyanızda 3 sayfa mevcut, hangi sayfanın A1 hücresi olabilir?
Son söyleminizden anladığım belirtmediğiniz sayfanın A1 hücresine isim yazılacak, sayfada olanlar sarıya boyanacak, sonra A1 e yeni bir isim girildiğinde bu isim sarıya boyanacak, ama bu durumda önceki sarıya boyananlar kalacak mı yoksa sadece A1 de yazılı olan mı sarıya boyalı duracak?

Sorunuzu ayrıntılı anlatırsanız anlaması da kolay olacaktır.

 

[netzone]

Söz konusu sayfanın 2025-2026 olduğu varsayımına göre;
1.satıra yeni boş satır ekleyerek A1 hücresine veri girişi yapıldığında aşağıdaki kodu ilgili sayfanın kodlarına eklerseniz yazdığınız isim eşleşirse dolgusunu sarı yapacaktır, A1'e yeni bir isim yazdığınızda eski haline geri gelip son giriş yaptığınız isimler sarı olacaktır.
A1 Hücresinde bir isim var iken yeni bir hücreye bu isim girilirse bu hücreyi de sarıya boyayacaktır.

*Kodlar yapay zeka tarafından hazırlanmıştır.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AramaDegeri As Variant
    Dim Hucre As Range
    Dim SonSatir As Long
    Dim SonSutun As Long
    Dim AramaAlani As Range
   
    ' Ekran güncellemelerini kapatarak hız kazanalım
    Application.ScreenUpdating = False
    Application.EnableEvents = False ' Sonsuz döngüyü önlemek için olayları geçici olarak kapat
   
    ' A1 hücresi değiştiyse tüm tablonun rengini sıfırlayıp baştan boyayalım
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Cells.Interior.ColorIndex = xlNone
    End If
   
    ' A1 boşsa işlem yapma
    AramaDegeri = Range("A1").Value
    If IsEmpty(AramaDegeri) Or AramaDegeri = "" Then
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Exit Sub
    End If
   
    ' Sayfadaki son dolu satır ve son dolu sütunu net olarak tespit et
    On Error Resume Next
    SonSatir = Cells.Find(What:="*", After:=Cells(1, 1), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    SonSutun = Cells.Find(What:="*", After:=Cells(1, 1), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    On Error GoTo 0
   
    ' Eğer sayfada veri varsa arama alanını belirle
    If SonSatir > 0 And SonSutun > 0 Then
        Set AramaAlani = Range(Cells(1, 1), Cells(SonSatir, SonSutun))
       
        ' Belirlenen tüm alan içinde döngü kurarak eşleşenleri sarı yap (A1 hariç)
        For Each Hucre In AramaAlani
            If Hucre.Address <> "$A$1" And Not IsError(Hucre.Value) Then
                If CStr(Hucre.Value) = CStr(AramaDegeri) Then
                    Hucre.Interior.Color = RGB(255, 255, 0) ' Sarı renk
                Else
                    ' Eğer değer uymuyorsa ve daha önce sarı boyandıysa eski rengini temizle
                    If Hucre.Interior.Color = RGB(255, 255, 0) Then
                        Hucre.Interior.ColorIndex = xlNone
                    End If
                End If
            End If
        Next Hucre
    End If
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub