النعديل علي كود تكرر الاسم , وضع رسالة تنبية

[ماجدجلال]

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

في الملف المرفق وجدت كود من موقع اجنبي يقوم بتلوين الخلايا التي يتكرر في الاسم اكثر من مرة , و ارغب في اضافة رسالة تنبية للمستخدم تفيد بوجود اسم مكرر , ولقد حاولت وضع الرسالة في الكود و لكني لم انجح , فقد كانت تتكر الرسالة مع كل عملية تحرير في الشيت , وهذا خطاء و ايضا تتكرر مع ادخال كل اسم و هذا خطاء 

المفروض انها تظهر فقط في حالة قيام الكود بتلوين الخلية فقط ,,,

ارجو المساعدة وشكرا لكم 

Book1.xls

[ماجدجلال]

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Row = 1 Then Exit Sub             ' IF ITS A HEADER, DO NOTHING.
    
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    Dim myDataRng As Range
    Dim cell As Range
     
    ' WE WILL SET THE RANGE (SECOND COLUMN).
    Set myDataRng = Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row)
     
    For Each cell In myDataRng
        cell.Offset(0, 0).Font.Color = vbBlack          ' DEFAULT COLOR.
 '-----------------------------------------MsgBox "áÏíß ÇÓã ãßÑÑ"
        ' LOCATE DUPLICATE VALUE(S) IN THE SPECIFIED.
        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed        ' CHANGE COLOR TO RED.
 '------------------------ MsgBox "áÏíß ÇÓã ãßÑÑ"
              End If
 '---------------------------- MsgBox "áÏíß ÇÓã ãßÑÑ"
    Next cell
    '------------------------------ MsgBox "áÏíß ÇÓã ãßÑÑ"
    Set myDataRng = Nothing
 '------------------------------ MsgBox "áÏíß ÇÓã ãßÑÑ"
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

خلال الايام الماضية حاولت الاعتماد علي نفسي , و جربت وضع الرسالة في مواقع مختلفة و لكنها فشلت ,,

ارجو منكم المساعدة , ربما يحتاج الي صياغة الكود من جديد

[عبدالله بشير عبدالله]

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

ملف ربما يتوافق مع طلبك

التنبيه في حالة التكرار .xls

تحياتي

[ماجدجلال]

شكرا لك أخي عبد الله على مساعدتك

الملف ممتاز جدا ولكن عند تعديله لإضافة دمج أكثر من خلية لم يعمل، حيث أن الفكرة تقوم علي دمج أكثر من خلية (الاسم الأول + اسم الأب + اسم الجد + اسم العائلة) في خلية واحدة. 

أشكرك من قلبي على إضافتك، وأرجو منك المساعدة أو من بقية الأساتذة الكرام... 

‫التنبيه في حالة التكرار - نسخة.xls

[الـعيدروس]

اخ ماجد جلال حفظك الله

متى تريد تنبية المستخدم بوجود اسماء مكرره

عند دخول الملف يظهر الرسالة مرة واحده

او عند اضافة بيانات جديده يشعر المستخدم

اذا فهم طلبك التنفيذ سهل

[ماجدجلال]

بارك الله فيك اخي العزيز 

اريد ان تظهر الرسالة عند اضافة بيانات جديدة ، 

لانه من المفترض عدم تكرار الاسم مرتين ، 

الله يوفقك و يسعدك ، ردك بعث الامل فيني 

شكرا لك 

[الـعيدروس]

السلام عليكم

جرب المرفق

 

 

Book1_Ali1.xls

تم تعديل أكتوبر 20, 2019 بواسطه الـعيدروس

[ماجدجلال]

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

الف الف شكرا 

الله يوفقك و يسعدك و يزيدك من فضلة وعلمة 

عمل رائع و ممتاز , كنت فقدت الامل و قالت لعلة مستحيل عمل ذلك في البرمجة 

الله يجزك الجنة ,,,

[الـعيدروس]

ولك مثل دعائك اضعاف مضاعفه اخ ماجد جلال

في حفظ الله

[ماجدجلال]

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

استاذي العزيز  العيدروس 

المستخدم للبرنامج السابق اعجب كثيرا برسالة التنبية التي قمت باضافتها ، غير انه انزعج من كونها تظهر و تختفي بسرعة ، فهل يمكن جعلها تتوقف و تختفي عند النقر علي اي زر ، حتي يستطيع المستخدم قراءت الرسالة 

و اعتذر عن كثرة  الطلبات ، و جزاك الله عنا الخير 

[الـعيدروس]

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

هذا السطر

If i Then CreateObject("WScript.Shell").Popup "الاسماء المكرره هيا " & S_F & vbNewLine & String(42, Srt) & vbNewLine & A_1, 1, "اسماء مكرره"

استبدله بالتالي

If i Then MsgBox "الاسماء المكرره هيا " & S_F & vbNewLine & String(42, Srt) & vbNewLine & A_1, vbInformation, "اسماء مكرره"

 

[ماجدجلال]

ماشاء الله تبارك الله 

نجح التعديل , الله يوفقك ويسعدك

شكرا يا دكتور  الف الف شكرا 

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