كيف أمنع تكرار بيانات لعمود معين في أكثر من ورقة عمل

[الشماسية]

السلام عليكم

لدي ورقتي عمل وأريد منع تكرار البيانات في عمود محدد في ورقتي العمل

بمعنى إذا كتبت اسم محمد في الورقة1 فلا يسمح بكتابته في نفس الورقة ولا حتى في الورقة2

طبعا لا يوجد واجهة وإنما ملف اكسل عادي.

شكرا لتعاونكم

تم تعديل سبتمبر 18 بواسطه الشماسية

[hegazee]

و عليكم السلام

 بداية يمكن عمل ذلك عن طريق التحقق من الصحة و الأفضل ارفاق ملف للعمل عليه

[أبومروان]

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

جرب هذه الطريقه بالمعادلات 

اصنع نطاق وليكن من   a1:a100 باسم AllNames

حدد العمود الذي تريد منع التكرار فيه مثلاً: A2:A1000 — لا تشمل الخلية A1 إذا كانت عنوانًا

اذهب إلى    Data ← Data Validation.

Allow: Custom

Formula اكتب 

كرر نفس الكلام علي الشيت 2 

=COUNTIF(AllNames, A2)=1

 

 

عدم التكرار بالمعادلات.xlsx

[أبومروان]

واليك طريقه اخري بالكود

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim cell As Range
    Dim newValue As String
    
    ' تأكد أن التغيير حدث في العمود A (العمود 1)
    If Target.Column <> 1 Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub ' تجنب اللصق الجماعي
    If IsEmpty(Target) Then Exit Sub
    
    Application.EnableEvents = False ' لمنع تشغيل الحدث مرارًا
    
    newValue = CStr(Target.Value)
    
    ' تحديد الأوراق
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' تحديد النطاقات (نأخذ من A2 إلى آخر خلية غير فارغة)
    Set rng1 = ws1.Range("A2:A" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row)
    Set rng2 = ws2.Range("A2:A" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)
    
    ' التحقق من التكرار في ورقة1 (باستثناء الخلية الحالية)
    For Each cell In rng1
        If cell.Address <> Target.Address And cell.Value = newValue Then
            MsgBox "القيمة '" & newValue & "' موجودة مسبقًا في " & ws1.Name & "!", vbExclamation
            Target.ClearContents
            GoTo Cleanup
        End If
    Next cell
    
    ' التحقق من التكرار في ورقة2
    For Each cell In rng2
        If cell.Value = newValue Then
            MsgBox "القيمة '" & newValue & "' موجودة مسبقًا في " & ws2.Name & "!", vbExclamation
            Target.ClearContents
            GoTo Cleanup
        End If
    Next cell

Cleanup:
    Application.EnableEvents = True
End Sub

 

طريقه اخري ب الكود.xlsm

[Emam1939]

On 9/30/2025 at 10:11 PM, أبومروان said:

=COUNTIF(AllNames, A2)=1