Makro ile Sorgulama

[ayagiz44]

Sicil Alanına yazdığımda eğer ad tanımladığım (sorgu) alanında var ise uyarı mesajı versin
Amaç Ad tanımlanan sicillerin yazılmasını engellemek

Selamlar

http://www.dosya.tc/server10/ey6t1a/SORGU.rar.html

 

[antonio]

=EĞER(EĞERSAY(Sayfa1!A2:KAYDIR(Sayfa1!A2;BAĞ_DEĞ_DOLU_SAY(Sayfa1!A:A)-1;0);A2);"Bu kayıt listede mevcuttur";"Bu kayıt listede mevcut değildir.")

 

[antonio]

Sicil Alanına yazdığımda eğer ad tanımladığım (sorgu) alanında var ise uyarı mesajı versin
Amaç Ad tanımlanan sicillerin yazılmasını engellemek
Selamlar
http://www.dosya.tc/server10/ey6t1a/SORGU.rar.html

Ad tanımlama olarak iki sütun seçmeniz, sorgulamada hataya neden olabilir. Sorgulamak istediğiniz sütunda olmayan değer yan taraftaki sütunda olabilir.

 

[ayagiz44]

Bu formülü Makroya çevirmem lazım

makro ile aratmam lazım Selamlar

 

[ayagiz44]

Anladım

sicil sorgusuda yeterli

 

[antonio]

Aşağıda da makro ile çözümünüz yer almaktadır.
Sayfa2 nin kod penceersine aşağıdaki kodları yapıştırınız:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet, ss As Long, alan As Range, k As Range
If Not Intersect(Target, [A2]) Is Nothing Then
    Set sh = Sheets("Sayfa1")
    ss = sh.Range("A" & Rows.Count).End(3).Row
    Set alan = sh.Range("A2:A" & ss)
    aranan = Target.Value
    Set k = alan.Find(aranan, , xlValues, xlWhole)
    If Not k Is Nothing Then
        MsgBox "Bu kayıt daha önceden girilmiştir.", vbExclamation, "antonio"
        Exit Sub
    End If
ElseIf Not Intersect(Target, [B1:B5]) Is Nothing Then
    '[B1:B5] hücresinde işlem yapınca çalışacak kodlarınız
    'kodlarınız ..........
    '...............
    '......................
ElseIf Not Intersect(Target, [D5:E15]) Is Nothing Then
    '[D5:E15] aralığında işlem yapınca çalışacak kodlarınız..
    'kodlarınız....
    'kodlarınız ..........
    '...............
    '......................
    
End If
End Sub

 

[ayagiz44]

Makro

Teşekkürler

 

[antonio]

Rica ederim.

 

[ayagiz44]

antonio

1- aynı sayfada 2 veya daha fazla
Private Sub Worksheet_Change(ByVal Target As Range)

başlayan makroyu nasıl gösterebilirim

2- Göndermiş olduğun makroya mesajla birlikte girişi nasıl engellerim.

 

[antonio]

1- aynı sayfada 2 veya daha fazla
Private Sub Worksheet_Change(ByVal Target As Range)

başlayan makroyu nasıl gösterebilirim

2- Göndermiş olduğun makroya mesajla birlikte girişi nasıl engellerim.

6 no'lu mesajımı güncelledim.

 

[ayagiz44]

yazım düzeni

yazım düzeni ekledim hata verdi

 

[ayagiz44]

İkinci sorgu çalışmadı

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet, ss As Long, alan As Range, k As Range
If Not Intersect(Target, [B8:B509]) Is Nothing Then
Set sh = Sheets("Sayfa1")
ss = sh.Range("B" & Rows.Count).End(3).Row
Set alan = sh.Range("aj2:aj" & ss)
aranan = Target.Value
Set k = alan.Find(aranan, , xlValues, xlWhole)
If Not k Is Nothing Then
MsgBox "BU PERSONEL AÇIKTADIR.LÜTFEN! AÇIKTAKİ PERSONELİ GİRMEYİNİZ...", vbExclamation, ""
Exit Sub
End If
ElseIf Not Intersect(Target, [B8:B509]) Is Nothing Then
Set sh = Sheets("Sayfa1")
ss = sh.Range("A" & Rows.Count).End(3).Row
Set alan = sh.Range("AA2:AA" & ss)
aranan = Target.Value
Set k = alan.Find(aranan, , xlValues, xlWhole)
If Not k Is Nothing Then
MsgBox "BU PERSONEL AKTİF GÖREV YAPAMAZ.LÜTFEN! BU PERSONELİ GİRMEYİNİZ...", vbExclamation, ""
Exit Sub
End If
End If
End Sub

 

[antonio]

Aşağıdaki kod mantığına dikkat ediniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ......................... 'değişken tanımları satırı
If Not Intersect(Target, [[COLOR="Red"][B]<hücre aralığı_1>[/B][/COLOR]]) Is Nothing Then
    'Kodlarınız....
       '..........................
         ' ............................
ElseIf Not Intersect(Target, [<[COLOR="Red"][B]başka bir hücre aralığı[/B][/COLOR]>]) Is Nothing Then
    'kodlarınız..............
    'kodlarınız ..........
    '...............
    '......................
ElseIf Not Intersect(Target, [<[COLOR="Red"][B]çok daha farklı bir hücre aralığı[/B][/COLOR]>]) Is Nothing Then
    'kodlarınız...
    'kodlarınız....
    'kodlarınız ..........
    '...............
    '......................
    
End If
End Sub