excell de hücre rengi arama

[usubaykan]

Merhaba;

Ozaman aşağıdaki kodu bu şekilde değiştiriniz.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bul As Range, Hücre As Range, U As Long
    If Intersect(Target, Range("E1")) Is Nothing Then Exit Sub
    Range("E10") = ""
    [COLOR=red]Set Bul = Rows("23:23").Find(What:=Target, LookAt:=xlWhole)
[/COLOR]    If Not Bul Is Nothing Then
    For U = 2 To Bul.Row
        If Cells(U, Bul.Column).Interior.ColorIndex = 6 Then
[COLOR=red]            Range("E10") = Cells(U, "AC")
[/COLOR]        End If
    Next
        If Range("E10") = "" Then MsgBox "Bu değer de kriter yok !", vbCritical, "Sn : " & Application.UserName
        
    End If
End Sub

 

[a_ceylan]

çok teşekkür ederim.Allah razı olsun senden.
Hakkını helal et.

 

[usubaykan]

çok teşekkür ederim.Allah razı olsun senden.
Hakkını helal et.

Rica ederim. Cümlemizden ALLAH razı olsun

 

[a_ceylan]

sn usubaykan mevcut en son tablomuzda makroyu çalştırdık yalnız şu ana kadar fark edemediğim bir olayla karşılaştım 23. satır "Z" kolonundaki değerden sonra çalışmıyor böyle bir kriter yok diyor. Sanırım şu anda çaılşan makro sarı rengi 23. satırdan sonra yukarıya doğru arıyor ama 23. satırın aşağısına doğru olan rengi bulamıyor galiba bir göz atarsan çok sevinirim.
Allaha emanet ol..

Tablo Ek'tedir

 

[usubaykan]

sn usubaykan mevcut en son tablomuzda makroyu çalştırdık yalnız şu ana kadar fark edemediğim bir olayla karşılaştım 23. satır "Z" kolonundaki değerden sonra çalışmıyor böyle bir kriter yok diyor. Sanırım şu anda çaılşan makro sarı rengi 23. satırdan sonra yukarıya doğru arıyor ama 23. satırın aşağısına doğru olan rengi bulamıyor galiba bir göz atarsan çok sevinirim.
Allaha emanet ol..

Tablo Ek'tedir

Merhaba;

Kodunuzu aşağıdaki gibi değiştiriniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bul As Range, U As Long
    If Intersect(Target, Range("A3")) Is Nothing Then Exit Sub
    Range("J1") = ""
    Set Bul = Rows("23:23").Find(What:=Target, LookAt:=xlWhole)
    If Not Bul Is Nothing Then
    [COLOR=Red]For U = 2 To Cells(65536, Bul.Column).End(3).Row[/COLOR]
        If Cells(U, Bul.Column).Interior.ColorIndex = 6 Then
            Range("J1") = Cells(U, "AD")
        End If
    Next
    End If
        If Range("J1") = "" Then
        MsgBox "Bu değer de kriter yok !", vbCritical, "Sn : " & Application.UserName
    End If
End Sub

 

[a_ceylan]

teşekkürler

 

[usubaykan]

teşekkürler

Rica ederim