Hücre içinde seçilen değere karşılık msg box'da istenileni yazdırmak

[vokri77]

Merhaba.

Excel dosyada D1 ile D1000 arasındaki herhangi bir hücrede combo box (validation) içinden ;
"ada" seçildiğinde otomatik msg box açıp "volkan" yaz,
"bal" seçildiğinde msg box açıp "ahmet" yaz,
"cep" seçildiğinde msg box açıp "veli" yaz

işlemini kod ile nasıl yaptırabiliriz ?

Yardımlarınızı için şimdiden çok teşekkürler

İyi Çalışmalar

 

[Orion1]

Çalışma sayfasının kod modülüne;

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1:D1000]) Is Nothing Then Exit Sub
On Error Resume Next
Select Case UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
    Case "ADA"
    MsgBox "volkan"
    Case "BAL"
    MsgBox "ahmet"
    Case "CEP"
    MsgBox "veli"
End Select
End Sub

 

[security]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1: D1000]) Is Nothing Then Exit Sub
On Error Resume Next
Select Case UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
Case "ADA"
MsgBox "volkan"
Case "BAL"
MsgBox "ahmet"
Case "CEP"
MsgBox "veli"
Case "EVREN"
MsgBox "HOCAM SÜPER OLMUŞ TŞK"
End Select
End Sub

Bu Şekildede Olabilir...

 

[Orion1]

Bu Şekildede Olabilir...

Rica ederim.
İyi çalışmalar.

 

[vokri77]

Çok teşekkürler üstad.
Fakat ilgili aralıkta bir veriyi seçmeme rağmen msg box çıkmıyor. Neyi eksik yapmış olabilirim ?

 

[security]

Çok teşekkürler üstad.
Fakat ilgili aralıkta bir veriyi seçmeme rağmen msg box çıkmıyor. Neyi eksik yapmış olabilirim ?

Merhaba Hocamızın Kodları Sorunsuz Çalışıyor. Size Örnek Dosya Ekliyorum...

 

[vokri77]

Bendeki sorun case içindeki harflerin küçük olmasıymış. Büyük harf yazınca kod sorunsuz çalıştı.
Başka bir sütun (örn;E) için aynı şeyi yaptırmak istiyorum. Aynı prosedür içine mi kod yazmak lazım ?

Teşekkürler

 

[security]

Bendeki sorun case içindeki harflerin küçük olmasıymış. Büyük harf yazınca kod sorunsuz çalıştı.
Başka bir sütun (örn;E) için aynı şeyi yaptırmak istiyorum. Aynı prosedür içine mi kod yazmak lazım ?

Teşekkürler

SADECE E1 E1000 ARASI İÇİN

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E1:E1000]) Is Nothing Then Exit Sub
On Error Resume Next
Select Case UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
    Case "ADA"
    MsgBox "volkan"
    Case "BAL"
    MsgBox "ahmet"
    Case "CEP"
    MsgBox "veli"
End Select
End Sub

BU KODU KULLANINIZ...

 

[security]

Hem d1 d1000 e1 e1000 için ise

private sub worksheet_change(byval target as range)
ıf ıntersect(target, [e1:e1000,d1: D1000]) ıs nothing then exit sub
on error resume next
select case ucase(replace(replace(target.value, "ı", "ı"), "i", "i"))
case "ada"
msgbox "volkan"
case "bal"
msgbox "ahmet"
case "cep"
msgbox "veli"
end select
end sub

kodunu kullanınız... Kolay gelsin...

 

[security]

SN: vokri77 İstediğiniz Kodlar Eklenmitir...