عدم تكرار الرقم في صفحات مختلفه

[محمد سامر]

السلام عليكم ورحمة الله وبركاته

ههل هناك كود يمنع تكرار الأرقام في صفحات مختلفة ولتكن 3 صفحات كلهم في العمود "A" الموضح بالملف باللون الأصفر في الثلاث صفحات....

وجزاكم الله خيرا

عدم التكرار.xlsm

 

[محمد سامر]

هل يمكن التعديل على هذا الكود ليشمل الثلاث صفحات معا في نفس الوقت في الملف السابق

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim RN1 As Range
Dim RN2 As Range
Dim Q1

    Set RN1 = Range("a11:a613")
    Q1 = Range(Target.Address)
    For Each RN2 In RN1
        If Q1 <> "" And RN2.Address <> Target.Address And RN2 = Q1 Then
        MsgBox "الادخال :   " & Target.Value & "  مكرر سيتم حذفه ", vbMsgBoxRight, "ادخال مكرر"
        Cells(Target.Row, Target.Column).Select
        Selection = ""
        Exit Sub
        End If
    Next

End Sub

 

تم تعديل مايو 25, 2018 بواسطه محمد سامر

[Ali Mohamed Ali]

وعليكم السلام اخى الكريم

هل ينفع معك هذا الملف-ترقيم وتسلسل تلقائى لثلاثة صفحات

 

Auto_numbering-ترقيم تسلسلي متواصل في كل صفحة.xlsx

[محمد سامر]

جزاك الله خيرا اخ علي

ليس هذا هو المطلوب اطلاقا

المطلوب :

عند وجود رقم  ما في احد الصفحات في الخليه ""a"تحديدا.... عند كتابته في صفحه اخرى في الخليه"a" تظهر رساله تفيد بأن الرقم مكرر في صفحه اخرى

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

جرب هذا الملف

الكود

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 And Target.Count = 1 Then
 Dim x1, x2, x3, st
 Dim r1%, r2%, r3%
 st = Target.Value
 Dim rg1 As Range, rg2 As Range, rg3 As Range
 r1 = Sheets("data1").Cells(Rows.Count, 1).End(3).Row
 r2 = Sheets("data2").Cells(Rows.Count, 1).End(3).Row
 r3 = Sheets("data3").Cells(Rows.Count, 1).End(3).Row

 Set rg1 = Sheets("data1").Cells(1, 1).Resize(r1)
 Set rg2 = Sheets("data2").Cells(1, 1).Resize(r2)
 Set rg3 = Sheets("data3").Cells(1, 1).Resize(r3)

 x1 = Application.CountIf(rg1, st)
 x2 = Application.CountIf(rg2, st)
 x3 = Application.CountIf(rg3, st)

 If x1 + x2 + x3 > 1 Then
 MsgBox "the entred value is not unique" & Chr(10) & "I Can't Except that"
 Target.Value = vbNullString
 End If
End If
Application.EnableEvents = True
End Sub

الملف مرفق

No Repitition in 3sheets.xlsm

[محمد سامر]

جزاك الله خيرا استاذنا

 هذا هو المطلوب