Soru Kontrol tablosu

Katılım
24 Ağustos 2013
Mesajlar
73
Excel Vers. ve Dili
2010
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

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
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.

Kod:
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
 
Son düzenleme:
Katılım
24 Ağustos 2013
Mesajlar
73
Excel Vers. ve Dili
2010
Merhaba
Çok güzel oldu gözlerim ışildadi resmen yardiminiz için teşekkür ederim.
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Merhaba.

Kod:
    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
 

Ekli dosyalar

Son düzenleme:

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
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
 
Katılım
24 Ağustos 2013
Mesajlar
73
Excel Vers. ve Dili
2010
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

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Örnek dosyada aşağıdaki kodları çalıştırdım sorunsuz çalışıyor.

Kod:
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
 
Katılım
24 Ağustos 2013
Mesajlar
73
Excel Vers. ve Dili
2010
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

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Aşağıdaki kodları kullanın.

Kod:
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
 
Katılım
24 Ağustos 2013
Mesajlar
73
Excel Vers. ve Dili
2010
Bilgi hayat kurtarır diye boşuna dememişler.Klavyenize sağlık.Çok iyi çalışıyor.Teşekkür ederim.Saygılar
 
Üst