عبدالعزيزالمدني قام بنشر يناير 15, 2016 قام بنشر يناير 15, 2016 السلام عليكم اخواني ماهي الداله التي توزع الاسم الى ( الاسم اسم الاب اسم الجد اسم الجد الثاني اللقب ) مع مراعاة 1- ان يكون الاخير هو اللقب اذا كان الاسم اقل من رباعي 2- الاسماء التي تتكون من شقين ك( عبد الرحمن بن عثيمين زين العابدين )
ياسر خليل أبو البراء قام بنشر يناير 15, 2016 قام بنشر يناير 15, 2016 أخي الكريم عبد العزيز المدني قم بضغط ملفك وإرفاقه ليتسنى للجميع تقديم المساعدة تقبل تحياتي
عبدالعزيزالمدني قام بنشر يناير 15, 2016 الكاتب قام بنشر يناير 15, 2016 5 دقائق مضت, ياسر خليل أبو البراء said: أخي الكريم عبد العزيز المدني قم بضغط ملفك وإرفاقه ليتسنى للجميع تقديم المساعدة تقبل تحياتي تسلم استاذي العزيز ياسر خليل أبو البراء said على سرعة استجابتك وهذا الملف المرفق 2003 وللعلم اشتغل انا على اكسيل 2013 توزيع الاسم.rar
ياسر خليل أبو البراء قام بنشر يناير 15, 2016 قام بنشر يناير 15, 2016 أخي الكريم عبد العزيز إليك دالة معرفة تقوم بالأمر ونسبة نجاحها حوالي 95% .. الأمر لن يسلم من بعض الأخطاء البسيطة ... توضع الدالة المعرفة في موديول جديد .. 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 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 On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") Kh_Names = Kh_String Exit Function Err_Kh_Names: Kh_Names = "" End Function وإليك الملف المرفق فيه توضيح لكيفية استخدام الدالة أرجو أن تفي بالغرض تقبل تحياتي Split Compound Names UDF Function.rar 2
عبدالعزيزالمدني قام بنشر يناير 15, 2016 الكاتب قام بنشر يناير 15, 2016 منذ ساعه, ياسر خليل أبو البراء said: أخي الكريم عبد العزيز إليك دالة معرفة تقوم بالأمر ونسبة نجاحها حوالي 95% .. الأمر لن يسلم من بعض الأخطاء البسيطة ... توضع الدالة المعرفة في موديول جديد .. 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 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 On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") Kh_Names = Kh_String Exit Function Err_Kh_Names: Kh_Names = "" End Function وإليك الملف المرفق فيه توضيح لكيفية استخدام الدالة أرجو أن تفي بالغرض تقبل تحياتي Split Compound Names UDF Function.rar تسلم استاذي لكن الملف المرفق لايفتح
عبدالعزيزالمدني قام بنشر يناير 15, 2016 الكاتب قام بنشر يناير 15, 2016 الحمد لله فتح الملف بس كان ثقيل مره ولي استفسار لكن هذا الكود لابد ان يكون الاسم رباعي وانا اريد حتى وان كان الاسم اثنين مثلا (محمد المدني ) فقط اريد ان يضع الاسم الاول في خانة الاسم والاخير دايما في اللقب
ياسر خليل أبو البراء قام بنشر يناير 15, 2016 قام بنشر يناير 15, 2016 أخي الكريم عبد العزيز جرب الكود التالي في وجود الدالة المعرفة ... Sub TestRun() Dim I As Integer For I = 2 To Cells(Rows.Count, "B").End(xlUp).Row If Kh_Names(Cells(I, "B"), 1) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) ElseIf Kh_Names(Cells(I, "B"), 1, 2) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "G") = Kh_Names(Cells(I, "B"), 2) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "G") = Kh_Names(Cells(I, "B"), 3) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "E") = Kh_Names(Cells(I, "B"), 3) Cells(I, "G") = Kh_Names(Cells(I, "B"), 4) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4, 5) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "E") = Kh_Names(Cells(I, "B"), 3) Cells(I, "F") = Kh_Names(Cells(I, "B"), 4) Cells(I, "G") = Kh_Names(Cells(I, "B"), 5) End If Next I End Sub وهذا سيستلزم أن تقوم بالنقر على زر الأمر لكي يقوم الكود باختبار كل اسم على حدا .. حسب ما سترى في الملف المرفق أرجو أن يفي بالغرض Split Compound Names UDF Function V2.rar 4
قلم-الاكسل(عبدالعزيز) قام بنشر يناير 16, 2016 قام بنشر يناير 16, 2016 للعلم الكود الاول والملف الأول شغال ميه المية بس الثاني لا يوزع كل الاسماء شكرا للمهندس الكبير ياسر بارك الله فيك وجعلك مباركا ورزقك من حيث لا تحتسب
ياسر خليل أبو البراء قام بنشر يناير 16, 2016 قام بنشر يناير 16, 2016 أخي الكريم عبد العزيز قلم الإكسيل يرجى توضيح الخلل من خلال ملفك المرفق ..حيث أن الكود الثاني امتداد للدالة المعرفة ويقوم بتوزيع الأسماء كل حسب المكان المناسب كما طلب أخونا عبد العزيز المدني 1
قلم-الاكسل(عبدالعزيز) قام بنشر يناير 16, 2016 قام بنشر يناير 16, 2016 سيدي المهندس والمبدع والممتع بمشاركاته وطول باله وسعة قلبه وسع الله الواسع عليك دنيا وأخرى في رزقك وكل أمورك هذه صورة خطأ المعادلة الثانية حيث ان بعض الاسماء لم تتوزع بعد الضغط على مفتاح run
ياسر خليل أبو البراء قام بنشر يناير 16, 2016 قام بنشر يناير 16, 2016 أخي الكريم قلم الإكسيل بارك الله فيك وجزيت خيراً على دعواتك الطيبة المباركة بالنسبة للكود ::: ------------------ أنا مجرب الكود بدل المرة ألف مرة لأني أستخدمه في برامجي الخاصة تأكد من أنك لم تحذف أي شيء من الكود أو الدالة المعرفة .. ضع الكود التالي بالكامل في موديول جديد ثم نفذ الأمر مرة أخرى Sub TestRun() Dim I As Integer For I = 2 To Cells(Rows.Count, "B").End(xlUp).Row If Kh_Names(Cells(I, "B"), 1) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) ElseIf Kh_Names(Cells(I, "B"), 1, 2) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "G") = Kh_Names(Cells(I, "B"), 2) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "G") = Kh_Names(Cells(I, "B"), 3) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "E") = Kh_Names(Cells(I, "B"), 3) Cells(I, "G") = Kh_Names(Cells(I, "B"), 4) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4, 5) = Cells(I, "B") Then Cells(I, "C") = Kh_Names(Cells(I, "B"), 1) Cells(I, "D") = Kh_Names(Cells(I, "B"), 2) Cells(I, "E") = Kh_Names(Cells(I, "B"), 3) Cells(I, "F") = Kh_Names(Cells(I, "B"), 4) Cells(I, "G") = Kh_Names(Cells(I, "B"), 5) End If Next I 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 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 On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") Kh_Names = Kh_String Exit Function Err_Kh_Names: Kh_Names = "" End Function وهذه صورة من ورقة العمل بعد الضغط على الأمر Run ويمكن التأكد من عمل الكود من الأخوة الكرام الذين جربوا الملف الأخير تقبل تحياتي 2
عبدالعزيزالمدني قام بنشر يناير 16, 2016 الكاتب قام بنشر يناير 16, 2016 (معدل) من لايشكر الناس لايشكر الله شكرا استاذنا الكود عندي شغال تمام التمام وانا من امس احاول التعليق والرد وتقديم الشكر لاستاذنا ياسر خليل أبوالبراء فلم استطع تطلع لي رسايل لاتملك الصلاحيه لذلك تم تعديل يناير 16, 2016 بواسطه عبدالعزيزالمدني 1
ياسر خليل أبو البراء قام بنشر يناير 16, 2016 قام بنشر يناير 16, 2016 جزيت خيراً أخي الفاضل عبد العزيز المدني والحمد لله أن تم المطلوب على خير .. كما نتمنى أن يعمل الكود لدى عبد العزيز الآخر (قلم الإكسيل) .. في انتظار محاولاته أخي قلم الإكسيل .. ما هي نسخة الأوفيس التي تعمل عليها؟ 1
قلم-الاكسل(عبدالعزيز) قام بنشر يناير 17, 2016 قام بنشر يناير 17, 2016 (معدل) 2016 النسخة الاحترافية لكن ليست مشكلة المهم ان احد الاكواد عمل لدي والشي الثاني ان صاحب الموضوع قد عمل لديه شكرا لك المبدع العزيز المهندس ياسر على اهتمامك ورعايتك رعاك الله اينما كنت المهندس ياسر اشتغل الكود بعد تغيير الاسماء الموجودة بالجدول المرفق شكرا لك باركك الرحمن ولا تنسانا بإبداعاتك المتواصل جعل الله لك بكل حرف اجرا مثل جبال تهامة اللهم امين تم تعديل يناير 17, 2016 بواسطه قلم-الاكسل(عبدالعزيز) 1
محي الدين ابو البشر قام بنشر يناير 17, 2016 قام بنشر يناير 17, 2016 السلام عليم استاذي العزيز بارك الله بجهودك وجزاك الله كل خير هناك ملحوظة وهي انه اذا كان اسمين مركبين لا يعمل بشك صحيح مثلا:(عبد الله محمد سعيد أحمد العاني) حيث: الاسم عبد الله اسم الاب محمد سعيد اسم الجد أحمد الكنية العاني
ياسر خليل أبو البراء قام بنشر يناير 17, 2016 قام بنشر يناير 17, 2016 أخي الكريم محي الدين .. يمكنك التغلب على هذه المشكلة بأن تحذف المسافة في الاسم المركب حيث أنه يستحيل التعامل مع كل الأسماء المركبة .. لأن هناك أسماء فيها اسم محمد وسعيد وغير مركبة ..كيف سيتعرف الإكسيل عليها في هذه الحالة ؟؟ ما هو المنطق الذي سيتم تتبعه لحل مشكلة الأسماء المركبة في هذه الحالة وأنا أخبرت أن الدالة تعمل بنسبة كبيرة ولكن لن تصل إلى نسبة 100% .. فيمكن التغلب ببساطة على هذه المشكلة بأن لا تضع مسافة بين الأسماء المركبة فيكون الاسم محمدسعيد بشكل مباشر بدون مسافة بينهما هذا والله أعلم
محي الدين ابو البشر قام بنشر يناير 17, 2016 قام بنشر يناير 17, 2016 استاذي العزيز كلامك صح 100% وآسف اذا كنت أزعجتك ولكن ما حصل معي انه أتاني قائمة اسماء من مصدر وقائمة لنفس الأسماء من مصدر آخر ( حوالي 9000 اسم) والمطلوب مني ان أنقل معلمة من احدى القائمتين للقائمة الثانية المشكلة ان من كتب الاسماء شخصين مختلفين وهناك مشاكل كثيرة بين القائمتين واضناني الموضوع والآب بقي حوالي 2500 اسم لم اصل لنقل المعلومة من احدى القائميتن للثانية هذه مشكلتي واسف مرة اخرى على ازعاجك وسامحني
مختار البركاني قام بنشر يناير 17, 2016 قام بنشر يناير 17, 2016 بارك الله فيك استاذ ياسر خليل أبو البراء رائع جدا 1
ياسر خليل أبو البراء قام بنشر يناير 17, 2016 قام بنشر يناير 17, 2016 4 ساعات مضت, محي الدين ابو البشر said: استاذي العزيز كلامك صح 100% وآسف اذا كنت أزعجتك ولكن ما حصل معي انه أتاني قائمة اسماء من مصدر وقائمة لنفس الأسماء من مصدر آخر ( حوالي 9000 اسم) والمطلوب مني ان أنقل معلمة من احدى القائمتين للقائمة الثانية المشكلة ان من كتب الاسماء شخصين مختلفين وهناك مشاكل كثيرة بين القائمتين واضناني الموضوع والآب بقي حوالي 2500 اسم لم اصل لنقل المعلومة من احدى القائميتن للثانية هذه مشكلتي واسف مرة اخرى على ازعاجك وسامحني حاول تطرح المشكلة ليشاركك الأخوة الأعضاء في محاولة حلها .. إن شاء الله تكون مشكلة بسيطة لو حاولنا فيها كلنا ..غير لما تحاول لوحدك أخي الحبيب مختار البركاني مشكور على مرورك العطر بالموضوع .. ونورت الموضوع .. ولعلك استفدت تقبلوا تحياتي
عبدالعزيزالمدني قام بنشر يناير 19, 2016 الكاتب قام بنشر يناير 19, 2016 (معدل) استاذنا العزيز ياسر خليل أبو البراء بارك الله فيك وزادك الله علما عملت نموذج خاص بالكشوفات ولما بدأت بادراج الكود السابق لم يعمل معي في هذه الورقه كما عمل في الورقه السابقه فهلا تكرمت مشكورا التوضيح اين كان الخطاء عندي ومرفق الملف الذي اعمل عليه واريد في ورقتين نفس الكود وستلاحظ انني عملت في هذه الورقتين مربعين باسم (تحديث بيانات الطالب) و(تحديث بيانات الام ) كشوفات خاصه لتعبئة الشهائد.rar تم تعديل يناير 19, 2016 بواسطه عبدالعزيزالمدني
ياسر خليل أبو البراء قام بنشر يناير 19, 2016 قام بنشر يناير 19, 2016 أخي الكريم عبد العزيز المدني الملف محفوظ بصيغة xlsx وهذا الامتداد لا يحتفظ بالأكواد ..عندما تضع الكود وتحفظ ستظهر رسالة فيها كلمة Yes و No و Cancel انقر No سيظهر معك مربع حواري تحدد من خلاله اسم الملف والمكان المطلوب حفظ المصنف فيه وأهم شيء هو امتداد الملف اختار xlsm أو Excel Macro Enabled يمكنك الإطلاع على الموضوع التالي لتدرك بدايات التعامل مع الأكواد http://بداية الطريق لإنقاذ الغريق 1
عبدالعزيزالمدني قام بنشر يناير 19, 2016 الكاتب قام بنشر يناير 19, 2016 تسلم استاذ ياسر ساقوم بالتعديل والعمل حسب ارشاداتك جزاك الله خيرا
عبدالعزيزالمدني قام بنشر يناير 19, 2016 الكاتب قام بنشر يناير 19, 2016 استاذنا العزيز ياسر خليل أبو البراء للاسف لم استطع تنفيذ الماكرو كما يجب ارجوا مساعدتي شاكرا تعاونك ولا املك الا ان اقول سهل الله امرك ويسر دربك وادخلك الجنة انه سميع مجيب كشوفات خاصه لتعبئة الشهائد.rar
ياسر خليل أبو البراء قام بنشر يناير 19, 2016 قام بنشر يناير 19, 2016 أخي الكريم عبد العزيز المدني جرب الكود بهذا الشكل ليتناسب مع ملفك المرفق Sub TestRun() Dim I As Long For I = 8 To Cells(Rows.Count, "B").End(xlUp).Row If Kh_Names(Cells(I, "B"), 1) = Cells(I, "B") Then Cells(I, "E") = Kh_Names(Cells(I, "B"), 1) ElseIf Kh_Names(Cells(I, "B"), 1, 2) = Cells(I, "B") Then Cells(I, "E") = Kh_Names(Cells(I, "B"), 1) Cells(I, "I") = Kh_Names(Cells(I, "B"), 2) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3) = Cells(I, "B") Then Cells(I, "E") = Kh_Names(Cells(I, "B"), 1) Cells(I, "F") = Kh_Names(Cells(I, "B"), 2) Cells(I, "I") = Kh_Names(Cells(I, "B"), 3) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4) = Cells(I, "B") Then Cells(I, "E") = Kh_Names(Cells(I, "B"), 1) Cells(I, "F") = Kh_Names(Cells(I, "B"), 2) Cells(I, "G") = Kh_Names(Cells(I, "B"), 3) Cells(I, "I") = Kh_Names(Cells(I, "B"), 4) ElseIf Kh_Names(Cells(I, "B"), 1, 2, 3, 4, 5) = Cells(I, "B") Then Cells(I, "E") = Kh_Names(Cells(I, "B"), 1) Cells(I, "F") = Kh_Names(Cells(I, "B"), 2) Cells(I, "G") = Kh_Names(Cells(I, "B"), 3) Cells(I, "H") = Kh_Names(Cells(I, "B"), 4) Cells(I, "I") = Kh_Names(Cells(I, "B"), 5) Else Cells(I, "E") = Kh_Names(Cells(I, "B"), 1) Cells(I, "F") = Kh_Names(Cells(I, "B"), 2) Cells(I, "G") = Kh_Names(Cells(I, "B"), 3) Cells(I, "H") = Kh_Names(Cells(I, "B"), 4) Cells(I, "I") = Kh_Names(Cells(I, "B"), 5) End If Next I 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 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 On Error GoTo 0 Kh_String = Replace(Trim(Kh_String), "^", " ") Kh_Names = Kh_String Exit Function Err_Kh_Names: Kh_Names = "" End Function بالنسبة لنتائج الكود لن تكون صحيحة بسبب سوء البيانات المدخلة فمثلا الاسم ناصرسعدناصرمحمدالغيلي لا توجد أية مسافات في الاسم من ثم سيعامله الكود على أنه اسم واحد ويتم وضع كامل الاسم في خلية الاسم فقط يوجد مسافات كثيرة في الأسماء .. مثل صا لح (قم بإزالة مثل هذه المسافات) - هشا م - منا ل ... ويوجد أسماء كثيرة بهذا الشكل إذا أردت أن تحصل على نتائج صحيحة فلابد أن تكون المدخلات صحيحة تقبل تحياتي 2
عبدالعزيزالمدني قام بنشر يناير 20, 2016 الكاتب قام بنشر يناير 20, 2016 تسلم استاذ ياسر خليل أبو البراء وجزاك الله الف خير لو تكرمت تابع تعديل الملف المرفق وعدل كود تحديث بيانات الام فلم استطع اصلاحه كما الكود الاول اسم الطالب كشوفات خاصه لتعبئة الشهائد.rar
الردود الموصى بها