التنبه عند تكرار قيمة

[أبوأحـمـد]

أولا : بما أن هذه أول مشاركة لي اسمحوا لي أن أقدم تحياتي لجميع أعضاء ومشرفي وأعضاء مجلس إدارة في هذا المنتدى الرائع

وأتمنى أن أستفيد وأفيد اخواني الكرام وأن تسود روح الأخوة الصادقة بيننا

ثانيا : السؤال :) :lol:

عندي مثلا من (A1:A10 ) يوجد مجموعة أرقام

أريد أن يقوم أكسل بالتنبيه إذا قام المستخدم بتكرار رقم في هذا النطاق

آمل أن يكون سؤالي مفهوم

[محمد طاهر عرفه]

السلام عليكم

أهلا وسهلا بك فى المنتدي

جرب هذا

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim Mymat(10) As Double

 Range("a1").Activate

 For i = 1 To 10

  Mymat(i) = Range("a1").Offset(i - 1, 0).Value

Next



 For i = 1 To 10

  For j = 1 To 10

    If Mymat(i) = Mymat(j) And i <> j Then

      MsgBox "cell no A" & i & "and A" & j & "are duplicated"

      Exit Sub

    End If

  Next j

 Next i


End Sub

[أبوأحـمـد]

مشكو جدا أستاذي محمد

كود أكثر من رائع

بس إذا أمكن في حالة خلو الخلايا ما يعطي رسالة

وآمل أن أكون أثقلت عليك

تحياتي وتقديري

[محمد طاهر عرفه]

السلام عليكم

جرب هذا

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim Mymat(10) As Double

 Range("a1").Activate

 For i = 1 To 10

  Mymat(i) = Range("a1").Offset(i - 1, 0).Value

Next



 For i = 1 To 10

  For j = 1 To 10

    If Mymat(i) = Mymat(j) And i <> j And (Not Mymat(i) = 0 Or Not Mymat(j) = 0) Then

      MsgBox "cell no A" & i & "and A" & j & "are duplicated"

      Exit Sub

    End If

  Next j

 Next i


End Sub

مع تحياتي

[Sharaf]

يمكن كذلك بإستخدام التنسيق الشرطى باختيار الخلايا

ثم

Formula is

=COUNTIF($A$1:$A$10;A3)>1

[أبوأحـمـد]

مشاء الله وفقك الله أستاذي محمد الكود الآن 100%

وكذلك مشرفنا الغالي Sharaf مثال ولا أروع

الله يديمكم ويحفظكم

وأعتذر أشغلتكم معاي

تحياتي للجميع

[محمد طاهر عرفه]

أهلا بك دائما أخونا الكريم

تم دمج المثالين فى مثال واحد

مع حذف الجملة التالية من الكود

Range("a1").Activate

حيث لا داعي لها

مرفق المثال

CheckBuplicated.rar

[محمد طاهر عرفه]

مثال آخر و لكن التنبيه بعد تجاوز الاربعة تكرارات

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Mymat(20) As Double
 For i = 1 To 20
  Mymat(i) = Range("a1").Offset(i - 1, 0).Value
Next

Dim mcounter As Integer

 For i = 1 To 20
 mcounter = 0
  For j = 1 To 20
    If Mymat(i) = Mymat(j) And i <> j And (Not Mymat(i) = 0 Or Not Mymat(j) = 0) Then
      mcounter = mcounter + 1
      If mcounter > 3 Then
        MsgBox "The Value (" & Mymat(i) & ") is duplicated for more than 4 times in the range A1:A20"
        Exit Sub
      End If
    End If
  Next j
 Next i

End Sub