hücreye girilen veri ile belirli bir hücrenin içeriğini değiştirme

[m.ensar]

Hayırlı günler;
B sütunundaki hücrelere elma (değişmeyen bir kelime) yazdığımda A sütununda ki hücrelerde her ne yazılıysa onu ARMUT yapmak istiyorum. örneğin A5 te Ankara, A6 tahta, A58 kalem gibi değişik veriler var. B sütununa karşılarına B5, B6, B58 lere elma yazdığımda A sütunundaki verilerin ARMUT istiyorum.
formül yada makro her ikiside olur yardımcı olur musunuz?

 

[hamitcan]

Sayfanın kod kısmına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 2 Then Exit Sub
    If Target.Text = "Elma" Then Target.Offset(, -1) = "Armut"
End Sub

 

[m.ensar]

Sayfanın kod kısmına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 2 Then Exit Sub
    If Target.Text = "Elma" Then Target.Offset(, -1) = "Armut"
End Sub

Hocam ilginiz için çok sağolun. Lakin kodları ekledim birşey değişmedi örnek bir çalışma ekliyorum çalışma içerisinede açıklama yazdım vaktiniz olursa bakar mısınız ?

 

[dEdE]

Merhaba,
ANA kod bölümüne yapıştırarak dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("T3:T" & Rows.Count)) Is Nothing Then Exit Sub
    x = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))
    If x = "TESLİM EDİLDİ" Then
        Target.Value = "TESLİM EDİLDİ"
        Target.Offset(, -14).Value = "Hizmeti Başladı"
    End If
End Sub

 

[m.ensar]

Böyle bir hata verdi hocam

 

[dEdE]

Merhaba,
Örnek dosyanızda hata vermiyor. İnceler misiniz?

 

[m.ensar]

Maalesef Hocam indirdim aynı hatayı veriyor. office2016 win10 64 bit kullanıyorum bununla ilgisi olur mu ki hocam

 

[dEdE]

Merhaba,
Eklediğim örnek dosya bende hatasız çalışıyor. Yukarıdaki ekran resminde görülen "Debug" tuşuna tıklayarak hatanın hangi satırdan kaynaklandığını paylaşırsanız çözüm bulmaya çalışırız.

 

[m.ensar]

Bir üst resimdeki hatalı ile aynı hocam o nedenle debug tuşuna basmadım

 

[m.ensar]

Buyrun üstadım ekran görüntüsü içeriği

 

[dEdE]

Kodun hata veren ikinci satırını If Intersect(Target, Range("T3:T" & Cells(Rows.Count, "T").End(3).Row)) Is Nothing Then Exit Sub ile değiştirerek dener misiniz?
Bir de gönderdiğim örnek dosyayı başka bir bilgisayarda deneme imkanınız varsa sonucu görmek isterim.

 

[m.ensar]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("T3:T" & Cells(Rows.Count, "T").End(3).Row)) Is Nothing Then Exit Sub
x = UCase(Replace(Replace(Target.Value, "i", "İ"), "ı", "I"))
If x = "TESLİM EDİLDİ" Then
Target.Value = "TESLİM EDİLDİ"
Target.Offset(, -14).Value = "Hizmeti Başladı"
End If
End Sub
Yine bu satırı hata olarak gösteriyor hocam hakkınızı helal edin uğraştırıyorum sizi

 

[m.ensar]

Günaydın hocalarım bu sorunu C sütununa bir formül yazarak çözemez miyiz? dEdE üstadımın yazdığı makro benim bilgisayarda çalışmadı. örneğin C Sütununa A sütununda hangi veri olursa olsun eğer B sütununa ARMUT yazmış isem A sütununda ki veri ELMA olsun bu şekilde bir formülde işimi ziyadesiyle görür. A sütunundaki hücre boş ise formül B sütununu da boş göstermeli.

 

[m.ensar]

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [A:A]) Is Nothing Then Exit Sub

With Target
If .Count > 1 Then Exit Sub
If .Value = "" Then
Cells(.Row, "B") = ""
Exit Sub
End If
If UCase(Replace(Replace(.Value, "ı", "I"), "i", "İ")) = "TESLİM EDİLDİ" Then
Cells(.Row, "B") = Format(Date, "dd.mm.yyyy")
End If
End With

End Sub

dEdE üstadım çok emek verdin çok sağolasın. Aradığımı nihayetinde buldum Ömer hocam hazırlamış bir başka sorun için dün çok aramış bulamamıştım. bu kod ziyadesiyle işimi görüyor.