منع تكرار البيانات المدخلة فى عمود معين فى جميع صفحات الملف

[alfalahrentcarmohamedelemam]

السلام وعليكم الاعضاء الكرام

اريد كود او اي طريقة لمنع تكرار البيانات المدخلة في العامود A 

لاكثر من شيت بحيث عند ادخال الخلية المكررة سواء في نفس الشيت او 

شيتات أخري يمنع الادخال او يعطي رسالة تحذيرية

تكرار البيانات في عامود.xlsx

[سليم حاصبيا]

جرب هذا الماكرو  ( اذا كان هناك تكرار  تصدر رسالة بمكان التكرار و يقوم الماكرو بمسح ما كتبته)

Option Explicit

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim x%, First As Range, y%, My_address$
Application.EnableEvents = False
 If Not Intersect(sh.Columns(1), Target) Is Nothing Then
        Set First = Cells(Target.Row, 1)
        y = Application.CountIf(ActiveSheet.Columns(1), First)
            If y > 1 Then
             MsgBox "Error!" & Chr(10) & "This Record is Allready Exits in" & Chr(10) & _
             ActiveSheet.Name
             Target = vbNullString
             GoTo Exit_me
            End If
      For Each sh In Sheets
          If sh.Name = ActiveSheet.Name Then GoTo My_next:
          x = Application.CountIf(sh.Columns(1), First)
          If x > 0 Then
          My_address = sh.Columns(1).Find(First, lookat:=1).Address
          MsgBox "Error!" & Chr(10) & "This Record Is Already Exits in" & Chr(10) & _
          sh.Name & ":" & My_address
          Target = vbNullString
          GoTo Exit_me
          End If
My_next:
      Next
 End If

Exit_me:
Application.EnableEvents = True
End Sub

الملف مرفق

No Repeat In All Sheets.xlsm

[حمود الحارثي]

هل من الممكن يكون ان تظهر في الرساله نعم او لا في حالة الضغط على نعم لا يتم المسح واذا تم الضغط على لا يتم المسح

ولك مني ارقى تحيه 

[سليم حاصبيا]

عندها يجب استبدال الكود الى هذا

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim x%, First As Range, y%, My_address$, Answer As Byte
Application.EnableEvents = False
 If Not Intersect(sh.Columns(1), Target) Is Nothing Then
        Set First = Cells(Target.Row, 1)
        y = Application.CountIf(ActiveSheet.Columns(1), First)
            If y > 1 Then
        My_address = ActiveSheet.Columns(1).Find(First, lookat:=1).Address
 Answer = MsgBox("Error!" & Chr(10) & "This Record is Allready Exits in" & Chr(10) & _
          " This Sheet cell:" & My_address & Chr(10) & "do you want to continue", vbYesNo)
                If Answer <> 6 Then
                  Target = vbNullString
                  GoTo Exit_me
                 Else
                  GoTo Exit_me
                End If
            End If
      For Each sh In Sheets
          If sh.Name = ActiveSheet.Name Then GoTo My_next:
          x = Application.CountIf(sh.Columns(1), First)
          If x > 0 Then
          My_address = sh.Columns(1).Find(First, lookat:=1).Address
          Answer = MsgBox("Error!" & Chr(10) & "This Record is Allready Exits in" & _
          Chr(10) & sh.Name & ":" & My_address & Chr(10) & _
          "do you want to continue", vbYesNo)
           If Answer <> 6 Then
             Target = vbNullString
             GoTo Exit_me
            End If
          GoTo Exit_me
          End If
My_next:
      Next
 End If

Exit_me:
Application.EnableEvents = True
End Sub

الملف من جديد

 

No Repeat In All Sheets_by_choise.xlsm

[حمود الحارثي]

تسلم استاذي العزيز 

لك مني ارقى تحيه وزادك الله من علمه وجعله في ميزان حسناتك.