Soru MSGBOX

[emrebenn]

Merhaba
Çalıştığım ürünler için kontrol etmem gereken bir check listim var.
Bunu el yordamı ile tek tek yapmak zorunda kalıyorum.
Örnek vermek gerekirse.x sayfasında B6:B600 hücrelerini kontrol ediyorum. Check list sayfamın A sutunun da arama yapmam gereken anahtar kelimeler mevcut; B stunun da ise açıklaması var.
x sayfasında b 500 hücresine chec list sayfamın a sutununda bulunan anahtar kelimelerden herhangi bir girilince MSGbox ile b hücresinde bulunan açıklamanın çıkarılması mümkünmüdür acaba.

Yardımınız için şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Bu işlem için örnek dosyanızı paylaşmalısınız.

 

[emrebenn]

Merhaba
Örnek bir dosya hazırlama çalıştım.Umarım yeteri kadar anlaşılır olmuştur.
Teşekkürler

https://dosya.co/k8hh00ai1c59/ÖRNEK_VARYANT.xls.html

 

[Korhan Ayhan]

İlk sayfanızın ismi üzerinde sağ klik yapın ve KOD GÖRÜNTÜLE seçeneğini seçin. Açılan pencerenin sağ bölümüne aşağıdaki kodu uygulayın.

Sonra excel sayfasına geri dönün.

B sütunun dolu hücrelere tıkladığınızda işlem gerçekleşecektir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Bul As Range
    
    If Intersect(Target, Range("B5:B" & Rows.Count)) Is Nothing Then Exit Sub
    If Target.Value <> "" Then
        Set Bul = Sheets("Check List").Range("B:B").Find(Target, , , xlWhole)
        If Not Bul Is Nothing Then MsgBox Bul.Offset(, 1)
    End If
End Sub

 

[emrebenn]

Korhan Bey Teşekkür ederim.Yönledirdiginiz şekilde kodu excele uyguladım.
Kodun çalıması için giriş yaptığım hücreye maus ile tıklamam gerekiyor.
Anahtar kelimem kopyala yaptır yöntemi veya klavye ile yazım yapınca kodu çalışmıyor.
Anahtar kelimenin bulunduğu hücreye maus ile tıklama yapıldıktan sonra çalışıyor.
Yapıştırma ile çalılması mümkünmü acaba.

 

[emrebenn]

Sorum günceldir.Konunun uzmanı arkadaşlardan yardım rica ederim.

 

[Korhan Ayhan]

Eski önerimi silip yerine aşağıdaki kodu uygulayıp deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    
    If Intersect(Target, Range("B5:B" & Rows.Count)) Is Nothing Then Exit Sub
    If Target.Value <> "" Then
        Set Bul = Sheets("Check List").Range("B:B").Find(Target, , , xlWhole)
        If Not Bul Is Nothing Then MsgBox Bul.Offset(, 1)
    End If
End Sub

 

[emrebenn]

Korhan bey yardımınız için teşekkür ederim.Bu hali ile çalışıyor ama şansımı biraz zorlayarak şunu söylemek istiyorum.
Tek anahtar kelime için kod dizini mükemmel çalışıyor fakat birden fazla anahtar kelime girilince "type mismatch" hatasını veriyor.Bunu düzeltmek için yapılacak bir şey var mı acaba ?
Yardımınız için teşekkür ederim

 

[Korhan Ayhan]

Birden fazla derken kaç adetten bahsediyorsunuz?

MsgBox nesnesinde görüntüleme sınırı var bunu aşan bir durum oluşursa verinin hepsini göremezsiniz.

 

[emrebenn]

2 adet anahtar kelimede hatayı veriyor
Tablonun hepsi seçilip dolu alanları silinince aynı hatayı tekrar veriyor.

 

[Korhan Ayhan]

Çok fazla veri kopyalarsanız donma-bekleme yaşayabilirsiniz.

Deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Veri As Range, Bul As Range, Mesaj As String
   
    On Error GoTo Son
   
    If Intersect(Target, Range("B5:B" & Rows.Count)) Is Nothing Then Exit Sub
   
    For Each Veri In Target.Cells
        If Veri.Column = 2 And Veri.Value <> "" Then
            Set Bul = Sheets("Check List").Range("B:B").Find(Veri.Value, , , xlWhole)
            If Not Bul Is Nothing Then Mesaj = Mesaj & vbCr & Bul.Offset(, 1)
        End If
    Next
   
    If Mesaj <> "" Then MsgBox Mesaj
Son:
End Sub

 

[emrebenn]

Şu hali ile bahsettigim hatalar gitti.Çok güzel çalışıyor.
Fahat anahtar kelimeyi B5:B sütününda degilde. A5:B olacak şekilde arıyor.
Elinize ayağınıza sağlık bu hali ilede kullana bilir.
Minnettarım çok teşekkür ederim.

 

[Korhan Ayhan]

Kod için "B5:B..." olarak tanımlı bahsettiğiniz şekilde işlem yapmaması gerekir.

Ama yine de koda küçük bir ekleme yaptım. Son halini deneyiniz.

 

[emrebenn]

ÇOOOOOK SAĞ OLUN KORHAN BEY.
TEKRAR TEKRAR VE TEKRAR TEŞEKKÜR EDERİM.
Beni gözlük kullanmaktan kurtardınız