Renklendirme

[Selcuk1903]

Excel sayfa 1 A sütununda A1 ile A50000 Arasında okuldaki öğrenci numarası bulunmaktadır. Benim amacım control f ile arama yaptığım zaman bulduğu öğrenci noyu kırmızıya otomatik boyaması.

Örneğin : öğrenci no 97 ben control f ye 97 yazıp ara dediğim zaman A sütununda bulunan 97 sayısını otomatik boyamasını istiyorum. Kolay gelsin iyi geceler

 

[uzmanamele]

Merhaba
Sayfanın kod bölümüne yazarak deneyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
   Cells.Interior.ColorIndex = xlNone
   Target.Cells.Interior.Color = 255
End Sub

 

[dost]

Merhaba,

Sub OgrenciNoBul()

Dim s1 As Worksheet
Dim sonsat As Long, Bul As Range
Dim Aranan

Set s1 = ThisWorkbook.Sheets("Sheet1") '<-- Çalıştığın sayfa ismi olmalı

sonsat = s1.Range("A" & s1.Rows.Count).End(xlUp).Row

s1.Range("A:A").Interior.Color = xlNone    'Eğer A sütunundaki renkleri kaldırmak isterseniz.

Aranan = InputBox(Prompt & "Öğrenci numarasını giriniz...")
If Aranan = "" Then Exit Sub

Set Bul = s1.Range("A1:A" & sonsat).Find(Aranan)

If Not Bul Is Nothing Then
    s1.Range("A" & Bul.Row).Interior.Color = vbRed
    s1.Range("A" & Bul.Row).Select   'Eğer bulunan hücrenin seçilmesini isterseniz.
Else
    MsgBox Aranan & " numaralı öğrenci bulunamadı!!!"
End If

End Sub

 

[Selcuk1903]

Merhaba
Sayfanın kod bölümüne yazarak deneyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
   Cells.Interior.ColorIndex = xlNone
   Target.Cells.Interior.Color = 255
End Sub

Teşekkür ederim

 

[Selcuk1903]

Merhaba,

Sub OgrenciNoBul()

Dim s1 As Worksheet
Dim sonsat As Long, Bul As Range
Dim Aranan

Set s1 = ThisWorkbook.Sheets("Sheet1") '<-- Çalıştığın sayfa ismi olmalı

sonsat = s1.Range("A" & s1.Rows.Count).End(xlUp).Row

s1.Range("A:A").Interior.Color = xlNone    'Eğer A sütunundaki renkleri kaldırmak isterseniz.

Aranan = InputBox(Prompt & "Öğrenci numarasını giriniz...")
If Aranan = "" Then Exit Sub

Set Bul = s1.Range("A1:A" & sonsat).Find(Aranan)

If Not Bul Is Nothing Then
    s1.Range("A" & Bul.Row).Interior.Color = vbRed
    s1.Range("A" & Bul.Row).Select   'Eğer bulunan hücrenin seçilmesini isterseniz.
Else
    MsgBox Aranan & " numaralı öğrenci bulunamadı!!!"
End If

End Sub

Teşekkür ederim