Soru Makro veya VBA ile Şarta Bağlı Karşı Hücreye Veri Yazdırmak

[aborinas]

Merhabalar,
A Sütununa malzeme isimleri giriyorum, bu malzemelerden A ve B malzemleri girildiğinde karşı hücreye ( B Sütununda) A için"..... iade edildi" ve B malzemesi için "..... kabul edildi." yazılsın. Diğer malzemeler için ise hiç bir şey yazılmasın boş kalsın. Bunu eğer fonksiyonu ile yapabiliyorum ama mümkünse makro veya vba ile yapmak mümkün mü? yardımcı olacak arkadaşlara şimdiden teşekkürler.
Örnek dosya

İndir örnek

Dosyayı indir örnek

dosya.co

 

[Mdemir63]

Selamlar
İnceleyiniz

 

[aborinas]

Selamlar
İnceleyiniz

Çok teşekkür ederim tam istediğim şekilde çalıştı.

 

[Mdemir63]

Rica Ederim
İyi çalışmalar

 

[aborinas]

Rica Ederim
İyi çalışmalar

Şöyle bir sıkıntı yaşıyorum, "..... iade edildi" ve "..... kabul edildi" noktalar yerine el ile farklı isimler giriyorum fakat makroyu her çalıştırdığım da noktalar yerine yazdığım kelimeyi silip "..... iade edildi" ve "..... kabul edildi" şeklinde geri döndürüyor. Bunun önlemek mümkün mü?

 

[Mdemir63]

Selamlar
Makro içinde noktalarla ilgili bir şey yok. Siz noktaların olduğu yere ne yazmak istiyorsunuz. Siz olmazsa aldığınız hatayı dosya üzerinde belirtirseniz ona göre çözüm üretilebilir.

 

[aborinas]

Selamlar
Makro içinde noktalarla ilgili bir şey yok. Siz noktaların olduğu yere ne yazmak istiyorsunuz. Siz olmazsa aldığınız hatayı dosya üzerinde belirtirseniz ona göre çözüm üretilebilir.

Öncelikle ilginizden dolayı teşekkür ederim. Dosya içinde derdimi anlatmaya çalıştım.

İndir örnek2

Dosyayı indir örnek2

dosya.co

 

[Mdemir63]

Selamlar
Bu bahsettiğiniz x, y, z gibi yazacağınız isimleri noktaların olduğu yerlere manuel mi yazacaksınız?

 

[aborinas]

Selamlar
Bu bahsettiğiniz x, y, z gibi yazacağınız isimleri noktaların olduğu yerlere manuel mi yazacaksınız?

Evet doğrudur, manuel gireceğim

 

[Mdemir63]

Selamlar

Ama kodu her çalıştırdığınızda manuel yazdıklarınızı siler

 

[aborinas]

Selamlar

Ama kodu her çalıştırdığınızda manuel yazdıklarınızı siler

Evet işte sıkıntı orada, farklı bir yol izlenebilir mi?

 

[Mdemir63]

Selamlar
Yazacağınız isimler belli ise çözüm üretilebilir

 

[aborinas]

Selamlar
Yazacağınız isimler belli ise çözüm üretilebilir

isimler belli değil ama siz bir de belliymiş gibi de yapabilir misiniz?

 

[Mdemir63]

Selamlar
Nasıl olacak bilemedim. belki üstatlar bir çözüm bulabilirler.

 

[aborinas]

Selamlar
Nasıl olacak bilemedim. belki üstatlar bir çözüm bulabilirler.

Teşekkür ederim değerli zamanınızı ayırdığınız için. Başka bir arkadaş yardımcı olursa elbette sevinirim.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu sayfanızın kod bölümüne uygulayınız.

A sütununa veri girişi yaptığınızda kod çalışacaktır. Eğer B sütunu dolu ise bir değişiklik yapmayacaktır. B sütunu boş ise isim girebilmeniz için bir inputbox karşınıza gelecektir. Buraya yazacağınız isim B sütununa yazılacaktır.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim My_Text As String
    If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
    Select Case Target
        Case "A malzemesi"
            If Target.Offset(, 1) = "" Then
10              My_Text = InputBox("İsim giriniz.")
                If My_Text = "" Then GoTo 10
                Target.Offset(, 1) = My_Text & " iade edildi."
            End If
        Case "B malzemesi"
            If Target.Offset(, 1) = "" Then
20              My_Text = InputBox("İsim giriniz.")
                If My_Text = "" Then GoTo 20
                Target.Offset(, 1) = My_Text & " kabul edildi."
            End If
        Case Else: Target.Offset(, 1) = ""
    End Select
End Sub

 

[aborinas]

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim My_Text As String If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub Select Case Target Case "A malzemesi" If Target.Offset(, 1) = "" Then 10 My_Text = InputBox("İsim giriniz.") If My_Text = "" Then GoTo 10 Target.Offset(, 1) = My_Text & " iade edildi." End If Case "B malzemesi" If Target.Offset(, 1) = "" Then 20 My_Text = InputBox("İsim giriniz.") If My_Text = "" Then GoTo 20 Target.Offset(, 1) = My_Text & " kabul edildi." End If Case Else: Target.Offset(, 1) = "" End Select End Sub

Merhaba Korhan bey, her zamanki gibi hızır gibi yetişmişsiniz çok teşekkür ederim.