ياسر خليل أبو البراء

ما الغير مفهوم بالنسبة لك .. قم بنسخ الكود .. اضغط Alt+ F11 للذهاب لمحرر الأكواد من قائمة Insert أدرج موديول جديد Module ثم الصق فيه الكود ارجع لورقة العمل ، واضغط ALt + F8 لتظهر لك قائمة بالإجراءات الفرعية الموجودة لديك اختر منها اسم الكود الذي أرفقته ثم انقر Run ولو فيه شيء في الشرح مش واضح يا ريت تحدده ... لا يكن كلامك بشكل عام .. والشرح بالعربي مش بالإنجليزي ..

أخي الكريم حامل المسك وعليكم السلام ورحمة الله وبركاته إليك ملف مرفق فيه عدة حلول وليس حل واحد فقط لمشكلتك ..اختر منها ما يناسبك رابط الملف المرفق من هنا

السؤال الهام جداً هنا .. هل التلوين سيفيدك ؟؟؟؟ لا أعتقد على الإطلاق أنه سيفيدك ..؟ ربما أفضل طريقة في حالتك هو حل الأخ سليم وهو عبارة عن معادلة في عمود مساعد توضع لمعرفة المكرر .. أما التلوين فلن يفيدك حتى لو وجدت طريقة لتسريع عمل الكود التلوين على ما أعتقد أنه لتمييز المكرر فهل ستقوم بالإطلاع على 25 ألف سطر ..!؟؟؟ أعتقد مستحيل من ثم يجب معرفة المطلوب بعد التلوين والعمل عليه مباشرةً .. فهذا من وجهة نظري أفضل

أخي الكريم الموضوع صعب بعض الشيء ولكن بحمد الله استطعت التوصل إلى حل قد يكون أقرب للمطلوب وإن لم يكن المطلوب بشكل تام .. جرب الملف التالي .. وضعت فيه في العمود الأول (الاسم الأصلي) ، والعمود الثاني (الاسم الذي تريد مقارنته) .. وفي الأعمدة من 3 إلى 7 قمت بتقسيم الاسم لأن هناك أسماء مركبة كما تعلم .. فقمت بتقسيم الاسم في هذه الأعمدة ، ثم عقدت عمليات مقارنة بين كل اسم والاسم الأصلي .. جرب الملف المرفق وإن شاء الله يفي بالغرض رابط الملف من هنا والكود المستخدم في الملف بالشكل التالي 'https://www.officena.net/ib/topic/71606-* '========================================= Sub Similar_Different_Between_Two_Names() 'Author : YasserKhalil 'Release : 06 - 09 - 2016 '------------------------- Dim iRow As Long, iCol As Long Dim countSim As Long, countDif As Long Dim strSim As String, strDif As String Application.ScreenUpdating = False For iRow = 2 To Cells(Rows.Count, "B").End(xlUp).Row For iCol = 3 To 7 If Cells(iRow, iCol) <> "" Then If InStr(Cells(iRow, 1), Cells(iRow, iCol)) > 0 Then countSim = countSim + 1 strSim = strSim & Cells(iRow, iCol) & " | " Else countDif = countDif + 1 strDif = strDif & Cells(iRow, iCol) & " | " End If End If Next iCol If countSim > 0 Then Cells(iRow, 10).Value = countSim Cells(iRow, 11).Value = VBA.Trim(Left(strSim, Len(strSim) - 2)) End If If countDif > 0 Then Cells(iRow, 8).Value = countDif Cells(iRow, 9).Value = VBA.Trim(Left(strDif, Len(strDif) - 2)) End If countSim = 0: strSim = "": countDif = 0:: strDif = "" Next iRow Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub Function Kh_Names(FullName As String, ParamArray Index1()) As String Dim I As Integer Dim Kh_Split, MyArray, Arr Dim Kh_String As String, SN As String, RE As String On Error GoTo Err_Kh_Names MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله", " الدين", " الإسلام", " الاسلام", " الحق", " النصر", " العهد", " النور", " بالله", "زين ") SN = Application.WorksheetFunction.Trim(FullName) For Each Arr In MyArray RE = Replace(Arr, " ", "^") SN = Replace(SN, Arr, RE) Next Arr Kh_Split = Split(SN, " ", , vbTextCompare) On Error Resume Next For I = 0 To UBound(Index1) Kh_String = Kh_String & " " & Kh_Split(Index1(I) - 1) Next I On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") Kh_Names = Kh_String Exit Function Err_Kh_Names: Kh_Names = "" End Function تقبل تحياتي

وعليكم السلام أخي الكريم الطيب سعد أهلاً بك في المنتدى ونورت بين إخوانك يرجى وضع ملف كتصور مبدئي للمطلوب لكي تجد استجابة من إخوانك بالمنتدى تقبل تحياتي

جزاكم الله خيراً أخي زياد على كلماتك الطيبة والحمد لله الذي بنعمته تتم الصالحات

وعليكم السلام أخي الكريم ياسر شوف الرابط ده يمكن يفيدك http://www.certification-crazy.net/mous_excel.htm

أخي الكريم الرمسيسي أهلاً بك في المنتدى ونورت بين إخوانك يرجى تغيير اسم الظهور للغة العربية .. كما يرجى الإطلاع على التوجيهات في الموضوعات المثبتة في صدر المنتدى إليك الكود مشروح بالتفصيل لتعرف كيف يتم الأمر رابط الكود من هنا

جزاكم الله خير الجزاء وجعل كل ما تقدمه في ميزان حسناتك يوم القيامة وإن كنت أتمنى ألا تعطينا أسماكاً بل تعلمنا الصيد .. فأنت صياد ماااااااااااااهر وعقر ... وعندك حيل وخدع مش عند حد .. نرجو الاستفادة منها إن شاء المولى

بارك الله فيك أخي الكريم يرجى تغيير اسم الظهور للغة العربية .. ولن أمل من التوجيه إلى أن يستجيب الأعضاء أو أرحل عن المنتدى (سامع حد بيقول ارحل ارحل مش عايزين .. )

بارك الله فيك وجزاك الله خيراً أخي العزيز محمد السباعي ونتمنى لك التوفيق واااااااااااااااااصل بلا فوااااااااااااااااااااصل

عوداً حميداً يا غالي ... اشتقنا لك والله كل عام وانت بخير وكل أعضاء المنتدى الكرام

اكتب المعادلة التالية في الخلية C2 =IF(LEFT(A2,2)="11","مصري",IF(LEFT(A2,2)="22","سعودي",IF(LEFT(A2,2)="33","يمني",""))) إذا حدث معك خطأ قم باستبدال الفاصلة العادية بفاصلة منقوطة حل آخر : بهذه المعادلة =IFERROR(LOOKUP(VALUE(LEFT(A2,2)),{11,12,13},{"مصري","سعودي","يمني"}),"")

الحمد لله الذي بنعمته تتم الصالحات يرجى أخي أحمد تحويل الاسم للهجري أي للغة العربية ويرجى الإطلاع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى تقبل تحياتي

أخي الكريم أحمد ديدو .. الصورة واضحة ولكن صدقني ينقص تفاصيل ربما لأنك ما زلت في أول الطريق لا تعرفها البرمجة تعني الإحاطة بأدق التفاصيل للتعامل معها بشكل صحيح ولكي تتجنب الأخطاء على سبيل المثال .. لم تذكر هل البيانات التي سترحل ..سترحل بعد آخر صف به بيانات أم أنه يتم مسح البيانات من ورقة شهر سبتمبر مثلاً قبل عملية الترحيل؟ عموماً جرب الكود التالي وإن شاء الله التعديل يكون سهل لو فيه تعديل .. وحاول دايماً تتكلم بلغة الإكسيل فهذا أيسر وأوضح للجميع رابط الكود من هنا

جزاكم الله خير الجزاء أستاذي الكبير عمر على هذه الموضوعات القيمة عند تجربة الملف وتحديد اسم من الليست بوكس لنقله إلى ورقة 2 .. صادفني الخطأ التالي عند هذا السطر UserForm1.ListBox1.RemoveItem (Current_Item)

بارك الله فيك أستاذي الغالي عمر وجزيت خير الجزاء على هذه الأعمال الرائعة ملحوظة صغيرة أرجو العمل عليها أو وضعها في الملاحظات إذا قمت بالتعديل على الملف : عند إغلاق الفورم من علامة الإغلاق فإن الملف يظل مفتوح في الخلفية .. اضبط لنا هذه النقطة تقبل تحياتي

بارك الله فيك وجزيت خيراً أخي الحبيب عمر الحسيني وجعل ما تقدمه في ميزان حسناتك يوم القيامة أخي الكريم أحمد من الأفضل أن تقوم بوضع صورة للخطأ أو المشكلة ، ولا يجب أن تتحدث عن المشكلة بشكل عام (فصل المسألة لتتضح الصورة ويستطيع أستاذنا عمر حل المشكلة لك بسهولة)

أخي الكريم زياد ..الموضوع ليس معقد على الإطلاق ،التعديل بسيط جداً وإن شاء الله مع ياسر خليل مفيش مستحيل ..كله ميسر بأمر الله عزوجل رابط الكود من هنا

وضح بالصور أحسن عشان الموضوع مش واضح بالنسبة لي بما فيه الكفاية .. تحدث بلغة الإكسيل أفضل

وعليكم السلام جرب أخي الدالة المعرفة التالية رابط الدالة المعرفة من هنا بعد وضع الدالة في موديول عادي .. اذهب لورقة العمل واكتب المعادلة التالية في الخلية B1 (بفرض أن التاريخ الهجري في الخلية A1) =ConvertDate(A1) تقبل تحياتي

جرب المعادلة التالية في الخلية L2 =IF(OR(K2="محروم",K2="غائب"),K2,IF(J2="","",ArbNum2Text(J2, 2,3,"درجة","درجات",1,"جزء","أجزاء",1)))

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

بارك الله فيك وجزاك الله خيراً أخي وحبيبي في الله أبو حنين كود رائع ومميز واستخدام مدهش للمصفوفات

نعم أخي عبد الباري ألاحظ ذلك .. وأتعمد عدم إرفاق ملفات ليس كسلاً مني ولكن رغبةً في أن يتقدموا ثم إن الملف المرفق أيسر بالنسبة لي إذا كانت الفكرة في التيسير وأقل في الوقت والجهد .. لكني أحب أن أفصل للعضو ماذا فعلت بالضبط حتى يطبق الحل بنفسه ، وحتى يتدرب على هذه الأمور وتكون بالنسبة له أمر عادي ومألوف .. وهذا يساهم فيما بعد في إنشاء جيل قادر على تقديم المساعدات لإخوانه بالمنتدى بارك الله فيك وجزاك الله خيراً