aynı veride uyarı

[hatirlabeni]

Kolay gelsin

A1 -A1000 sutununda veri ekliyorum. Bu aralıklarda ilk yazmış oldugum T.C. kimlik numarasından sonra aynısını tekrar baska yazınca bana uyarı vermesini istiyorum . T.C Kayıtlarda mevcut diye bunu nasıl sağlayabilirim. ?

 

[Korhan Ayhan]

Merhaba,

Bu işlemi yapmak istediğiniz sayfanızın kod bölümüne aşağıdaki kodu uygulayıp deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("A1:A1000")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target <> "" Then
    If WorksheetFunction.CountIf(Columns(1), Target) > 1 Then
        MsgBox "Mükerrer kayıt !", vbCritical
        Target.ClearContents
        Target.Select
        Exit Sub
    End If
    End If
Son:
End Sub

 

[hatirlabeni]

hocam kodu ayrı sayfada kullanınca sorunsz çalışıyor fakat kendi sayfama ekleyince hata veriyor acaba nedeni sayfamda ekli olan diğer kodlardan mı kaynaklanıyor ?

 

[Korhan Ayhan]

Merhaba,

Boş dosyada doğru çalışıyorsa; hatanın sebebi büyük ihtimalle sizin dosyanızda benzer kodlardan kaynaklanıyordur. Kodları birleştirip düzenlemeniz gerekebilir.

 

[hatirlabeni]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
If Cells(Target.Row, "E") > "" Then
Range("A2:K65536").Select
    Selection.Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A65536").End(3).Select
End If
End Sub

kullanmıs oldugum kodlar bunlar Hocam.

 

[hatirlabeni]

Kodları nasıl birleştire bilirim ?

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, Range("A1:A1000,E:E")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target <> "" And Target.Column = 1 Then
        If WorksheetFunction.CountIf(Columns(1), Target) > 1 Then
            MsgBox "Mükerrer kayıt !", vbCritical
            Target.ClearContents
            Target.Select
            Exit Sub
        End If
    ElseIf Target <> "" And Target.Column = 5 Then
        Range("A2:K" & Rows.Count).Sort Key1:=Range("E2"), Order1:=xlAscending
        Range("A" & Rows.Count).End(3).Select
    End If
Son:
End Sub

 

[hatirlabeni]

Hocam Ellerinize Sağlık Kolay Gelsin ...