Soru Kontrol tablosu

[emrebenn]

Merhaba
Şirketimize gelen ürün taleplerini kontrol ettigimiz bir tablom var.("A7:H450" araliginda.)Gelen talebi kapyalayip bu tabloya yapiştiriyorum.Bu işlemden sonra gelen ürunu bu tablodan kontrol ediyorum.Bu esnada gozumden kaçmamasi gereken hususlarin bana otomatik olarak bildirecek bi kod sistemi yapilabilirmi.Örnegin tablonun herhangi bir yerinde Kazakistan yazarsa bir hatirlatma yazisi cikip.kazakistan için eas satandarti olmalidir veya Hindistan yazdigi zaman Hististana ürün gönderilmeden önce yöneticiden onay alinacak uyarisi ve bunlar gibi atlmamam gereken haitlatmalari yapacak.Yardiminizi rica ederim

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kod ile yapılabilir.
Kodlar sayfanın kod kısmında olmalı. Dosya ekte.

Eğer sorun çözülmediyse lütfen örnek dosya üzerinde sorunuz.

Option Explicit
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Range
    Dim Ara() As Variant
    Dim Var As Integer
    Dim Adres As String
    Adres = "A7:H450" 'Kontrol edilecek adres(hücreler).
    Ara = Array("Kazakistan", "Hindistan", "İstediğini yaz") 'Kontrol edilecek kelimeler
   
    If Not Intersect(Target, Range(Adres)) Is Nothing Then
        For Each Bak In Intersect(Target, Range(Adres))
            For Var = 0 To UBound(Ara)
                If Bak.Text = Ara(Var) Then
                    Bak.ClearComments
                    Bak.AddComment Mesajlar(Ara(Var))
                    Exit For
                Else
                    Bak.ClearComments
                End If
            Next
        Next
    End If
End Sub

Function Mesajlar(ByVal Deger As String) As String
    Select Case Deger
        Case "Kazakistan" 'kontrol edileceke kelimeler
            Mesajlar = "Hücrede Kazakistan yazıyor, gerekli düzenlemeleri yap." 'Kelime bulunduğunda yazacak açıklama mesajı.
        Case "Hindistan"
            Mesajlar = "Hücrede Hindistan yazıyor, gerekli düzenlemeleri yap."
        Case "İstediğini yaz"
            Mesajlar = "İstediğin mesajı yaz."
           
    End Select
End Function

 

[emrebenn]

Merhaba
Çok güzel oldu gözlerim ışildadi resmen yardiminiz için teşekkür ederim.

 

[Muzaffer Ali]

Merhaba.

    With Worksheets("Veri")
        Set Ara = .Range("A2:A" & .Cells(Rows.Count, "A").End(3).Row)
    End With

kodlarında bulunan "Veri" Veri adlı sayfayı ifade ediyor.
.Range("A2:A" satırı da A kolonunu ifade edyiyor.
İsterseniz bunları değiştirebilirsiniz.

Dosyanız ekte

https://s2.dosya.tc/server10/vrwkho/Ornek.xlsm.html

 

[emrebenn]

Merhaba
tablo içerisinde boş gelen hücrelerede açıklama eklemesi yapıyor kod.Bunu düzeltmenin bir yolu var mı acaba.
Örnek dosyayı ekliyorum .
https://drive.google.com/file/d/1A1ZoH4b-izHcrBhhWuoDb2Ppw3GpjNVp/view?usp=sharing

 

[Muzaffer Ali]

If Not Intersect(Target, Range(Adres)) Is Nothing Then
Satırını silin yerine aşağıdaki satırı kopyalayın.

If Not Intersect(Target, Range(Adres)) Is Nothing And Not Target = "" Then

 

[emrebenn]

Kodu yazdıktan sonra bu hatayı vermeye başladı Run time eror 13 type mismatch.Zahmet veriyorum kusura bakmayın Sayın Dalgalı kur

 

[Muzaffer Ali]

Örnek dosyada aşağıdaki kodları çalıştırdım sorunsuz çalışıyor.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Range
    Dim Ara As Range
    Dim Var As Integer
    Dim Adres As String
    Adres = "A7:H450" 'Kontrol edilecek adres(hücreler).
    With Worksheets("Veri")
        Set Ara = .Range("A2:A" & .Cells(Rows.Count, "A").End(3).Row)
    End With
    If Target.Cells.Count > 1 And Target.Text = "" Then Exit Sub
    If Not Intersect(Target, Range(Adres)) Is Nothing And Not Target = "" Then
        For Each Bak In Intersect(Target, Range(Adres))
            For Var = 2 To Ara.Cells.Count + 2
                If Bak.Text = Ara(Var - 1, 1) Then
                    Bak.ClearComments
                    Bak.AddComment Ara(Var - 1, 2).Text
                    Exit For
                Else
                    Bak.ClearComments
                End If
            Next
        Next
    End If
End Sub

 

[emrebenn]

Eksik bilgi verdigim için özür dilerim.Hatayı ilgili satır aralıgına tabloyu kapyala-Yapıştır işlemini yaparken veriyor.El ile yazılınca bir sıkıntı olmuyor.

 

[Muzaffer Ali]

Aşağıdaki kodları kullanın.

Option Explicit
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Range
    Dim Ara As Range
    Dim Var As Integer
    Dim Adres As String
    Adres = "A:B" 'Kontrol edilecek adres(hücreler).
    With Worksheets("Veri")
        Set Ara = .Range("A2:A" & .Cells(Rows.Count, "A").End(3).Row)
    End With
    If Target.Cells.Count > 1 And Target.Text = "" Then Exit Sub
    If Not Intersect(Target, Range(Adres)) Is Nothing Then
        For Each Bak In Target
            For Var = 2 To Ara.Cells.Count + 2
                If Bak.Text = "" Then
                ElseIf Bak.Text = Ara(Var - 1, 1) Then
                    Bak.ClearComments
                    Bak.AddComment Ara(Var - 1, 2).Text
                    Exit For
                Else
                    Bak.ClearComments
                End If
            Next
        Next
    End If
End Sub

 

[emrebenn]

Bilgi hayat kurtarır diye boşuna dememişler.Klavyenize sağlık.Çok iyi çalışıyor.Teşekkür ederim.Saygılar