Belli kelimeyi hucreye girince baska hucreye yazı yazdırmak

[kneehot]

Arkadaslar merhaba. Baslık ne kadar anlasılır oldu bılemedım Excelde sayfa ıcerısınde kullandıgım bır makrom var asagıda ekledım. bu makronun ıcıne G sutunundakı herhangi bır hucreye elma yazarsam yazdıgım satırdakı B sutununa X yazmasını ıstıyorum fakat asagıdakı kodda buna benzer calıstıgı ıcın ekleyemedım. Yardım edersenız cok sevınırım. Tum yardımlara sımdıden tesekkurler.




Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4500")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, 24).Value = Time
Application.EnableEvents = True
If Intersect(Target, [C4:C1048576]) Is Nothing Then Cells(Target.Row, "C") = Format(Now, "dd.mm.yy")
End If
Dim k As Range, sonsat As Long
If Intersect(Target, [G4:G269]) Is Nothing Then Exit Sub
sonsat = Cells(Rows.Count, "AH").End(xlUp).Row
Set k = Range("AH1:AH" & sonsat).Find(Target.Value, , xlValues, xlWhole)
If Not k Is Nothing Then Target.Offset(0, 3).Value = Date
Set k = Nothing

End Sub

 

[Emir Hüseyin Çoban]

. . .

Tıkla >> #

 Tagının Kullanımı Hk.[/COLOR][/B][/URL]


[CODE]Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D4:D500")) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, 24).Value = Time
        Application.EnableEvents = True
        If Intersect(Target, [C4:C1048576]) Is Nothing Then Cells(Target.Row, "C") = Format(Now, "dd.mm.yy")
    End If
    Dim k As Range, sonsat As Long
    If Intersect(Target, [G4:G269]) Is Nothing Then Exit Sub
[B][COLOR="DarkRed"]    If UCase(Target.Value) = "ELMA" Then Cells(Target.Row, "B") = "X"[/COLOR][/B]
    sonsat = Cells(Rows.Count, "AH").End(xlUp).Row
    Set k = Range("AH1:AH" & sonsat).Find(Target.Value, , xlValues, xlWhole)
    If Not k Is Nothing Then Target.Offset(0, 3).Value = Date
    Set k = Nothing
End Sub

. . .

 

[kneehot]

Cok tesekkur ederım

 

[kneehot]

. . .

Tıkla >> #

 Tagının Kullanımı Hk.[/COLOR][/B][/URL]


[CODE]Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D4:D500")) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, 24).Value = Time
        Application.EnableEvents = True
        If Intersect(Target, [C4:C1048576]) Is Nothing Then Cells(Target.Row, "C") = Format(Now, "dd.mm.yy")
    End If
    Dim k As Range, sonsat As Long
    If Intersect(Target, [G4:G269]) Is Nothing Then Exit Sub
[B][COLOR="DarkRed"]    If UCase(Target.Value) = "ELMA" Then Cells(Target.Row, "B") = "X"[/COLOR][/B]
    sonsat = Cells(Rows.Count, "AH").End(xlUp).Row
    Set k = Range("AH1:AH" & sonsat).Find(Target.Value, , xlValues, xlWhole)
    If Not k Is Nothing Then Target.Offset(0, 3).Value = Date
    Set k = Nothing
End Sub

. . .

Merhaba. Yazdığınız bu makroyu kullanıyorum fakat farklı bir ihtiyacım çıktı ortaya tekrar yazmak istedim. yazdığınız makroda elma yazılırsa B sütünuna X koyan kısımda elma ya da muz yazılırsa x koysun şeklinde güncelleme yapabilirsek çok memnun olurum. Yardımlarınız için teşekkürler.

 

[kneehot]

Merhaba yapmak istediğim şeyin zor bişey olduğunu sanmıyorum buradan çok daha zor konularda yardım aldım daha önce. Bi el atarsanız çok sevinirim

 

[Korhan Ayhan]

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim k As Range, sonsat As Long
    
    If Not Intersect(Target, Range("D4:D500")) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, 24).Value = Time
        Application.EnableEvents = True
        If Intersect(Target, [C4:C1048576]) Is Nothing Then Cells(Target.Row, "C") = Format(Now, "dd.mm.yy")
    End If
    
    If Intersect(Target, [G4:G269]) Is Nothing Then Exit Sub
    If UCase(Target.Value) = "ELMA" Or UCase(Target.Value) = "MUZ" Then Cells(Target.Row, "B") = "X"
    sonsat = Cells(Rows.Count, "AH").End(xlUp).Row
    Set k = Range("AH1:AH" & sonsat).Find(Target.Value, , xlValues, xlWhole)
    If Not k Is Nothing Then Target.Offset(0, 3).Value = Date
    Set k = Nothing
End Sub

 

[kneehot]

Çok teşekkür ederim