أحمد سعيد قام بنشر سبتمبر 20, 2005 قام بنشر سبتمبر 20, 2005 السلام عليكم ورحمة الله وبركاته بارك الله فيكم وفى مجهوداتكم الرائعة جعل الله ذلك نورا لكم على الصراط يوم تزل الأقدام إخوانى لى طلب بسيط وهو لدى عدد كبير جدا من الأسماء قد كتبت بطريقة ليست واحدة وبالتالى البحث من خلالها صعب جدا فمنها مثلا يكتب أحمد بالهمزة ومرة بدون همزة وكلمة مكتوبة بالتاء المربوطة وأخرى بالهاء بدلا من التاء المربوطة وليس هناك امكانية عمل Replace فهل من ماكرو يقوم بتغيير هذه الحروف كل على حدة حيث أن الإكسل لا يفرق بين اللألف التى فوقها أو تحتها همزة والأخرى التى بدون همزة ولا بين التاء المربوطة والهاء وجزاكم الله خيرا كثيرا والسلام عليكم ورحمة الله وبركاته
محمد طاهر عرفه قام بنشر سبتمبر 20, 2005 قام بنشر سبتمبر 20, 2005 يا هلا :( مرفق ملف عبارة عن كود فى الاكسيس للاخ ابو هاجر قمت بالتعديل عليه ليناسب الاكسيل و يتم فيه استبدال ال أ و ا و آ و إ ب ا و ال ة و ال ه ب ه و ال ي و ال ى ب ي تاكد من تفعيل الماكرو ( مستوي الامان قبل فتح الملف ) :pp: ملاحظة : تم تعديل الملف فى مشاركة لاحقة للاخ m.hindawi
أحمد سعيد قام بنشر سبتمبر 21, 2005 الكاتب قام بنشر سبتمبر 21, 2005 وعليكم السلام ورحمة الله وبركاته أخى الفاضل محمد أولا جزاك الله خيرا على الرد السريع لكن أخى الحبيب الملف لايؤدى إلى أى نتائج صحيحة حيث أن ما به عبارة عن معادلة changesearch(A2) وأنت تعلم أن هذا ليس هو المطلوب أرجوكم إخوانى الكرام أن تساعدونى فى هذا الأمر حيث أننى فى مسيس الحاجة إليه وسوف يكون ذلك فى ميزان الحسان يوم القيامة
محمد طاهر عرفه قام بنشر سبتمبر 21, 2005 قام بنشر سبتمبر 21, 2005 يا اخي راجع الجملة السابقة تاكد من تفعيل الماكرو ( مستوي الامان قبل فتح الملف ) لكي تعمل الدوال التي اعدها المستخدم User defined functions لابد من مراجعة مستوي الامان للماكرو و ذلك من Tools Macro security و اختار Medium ليعمل مباشرة او Medium ليخيرك و بعد ذلك افتح الملف و بالتالي ستعمل الدالة و بكتابة اسم فى العمود الاول سينتج الاسم الجديد فى العمود الثاني و يمكنك سحب المعادلة لاي عدد من الخلايا يعني هذه دالة تعمل مثل دالة sum مثلا و لكن لابد من السماح بعمل الماكرو كما سبق
أحمد سعيد قام بنشر سبتمبر 22, 2005 الكاتب قام بنشر سبتمبر 22, 2005 السلام عليكم آسف للإزعاج الشديد لكم لكن ياسيدى إننى قد قمت بعمل كل ما هو مكتوب فى مشاركتك السابقة ولكن الملف يقوم بتكرار الإسم مرتين فى بعض الأحيان ويمكنك الرجوع إلى الملف الذى قد أرفقته سيادتك فى المشاركة الأولى لتجد أن كل من :- أحمد سعيد أحمد السيد قد تم تكراره مرتين عند تطبيق المعادلة أرجو سرعة الرد لشديد الإحتياج وجزاكم الله خيرا
m.hindawi قام بنشر سبتمبر 22, 2005 قام بنشر سبتمبر 22, 2005 بسم الله الرحمن االرحيم اخي الكريم الدالة تعمل جيدا اما بالنسبة الى التكرار فذلك طبيعي لانها تعتبر وظيفة اضافية اي انك تقوم ببرمجة خلية لحساب قيمة ما او تعديل في خلية اخرى على كل حال بعد اذن الاستاذ محمد طاهر قمت بتعميم الدالة على ملف الاكسل وادراجها في في حدث تغيير اية خلية وبالتالي فانت الان لست بحاجة الى برمجة اي خلية فقط اكتب الاسم الذي تريده في اي خلية و اي صفحة وسيتم تعديل الهمزة والالف المقصورة و التاء المربوطة اليا بدون ان تدرج الدالة في اي خلية الشرح ربما يكون معقد التطبيق بسيط جرب الملف التالي واعلمني بالنتيجة ملاحظة : تم تعديل الملف فى مشاركة لاحقة للاخ m.hindawi
m.hindawi قام بنشر سبتمبر 22, 2005 قام بنشر سبتمبر 22, 2005 بسم الله الرحمن الرحيم فعلا اخي الكريم بعد ان طرحت المشاركة السابقة تبين ان الاسم يتكرر ساحاول بعد اذن الاخ محمد طاهر ان اعدجل الدالة لتلافي هذا الخطأ والذي يحدث عند وجود كلمتين تحتويان على احرف بحاجة الى التغيير مثل أحمد الأحمد مثلا وانتظر ردي شكرا لك
m.hindawi قام بنشر سبتمبر 22, 2005 قام بنشر سبتمبر 22, 2005 بسم الله الرحمن الرحيم الموضوع كان بسيط ولم يحتج جهدا كبيرا على فكرة الدالة معممة وما عليك الا ان تكتب بالملف وفي اي خلية دون الحاجة لادراج دالة في خلية معينة جرب واعلمني بالنتيجة ملاحظة : تم تحديث الملف فى المشاركة التالية
محمد طاهر عرفه قام بنشر سبتمبر 22, 2005 قام بنشر سبتمبر 22, 2005 جزاك الله خيرا اخي M.hindawi علي التعديل و يسعدني جدا التعديل فى ما أضفت خصوصا ان كان للافضل كما حدث هنا :( فسبب تواجدنا معا فى المنتدي ان نستفيد من معرفة بعضنا و ان نكمل جميعا في اضافة ما نعرفه حتي نستفيد جميعا بالاضافة الي صاحب السؤال :d و أيضا التعميم الذي اضفته عملي جدا فالان هو لا يحتاج للاشارة الي الدالة او ان يشغل ماكرو (y) ملاحظة بسيطة : في الروتين الفرعي الخاصي بحدث عند التغيير لخلايا الملف اعتقد انه يمكننا حذف سطر changesearch (a) و الاكتفاء ب Target = changesearch(a) مباشرة كما فى الملف المرفق ام تري له ضرورة معينة ؟ أخي أحمد سعيد فقط اكتب فى أي مكان فى الملف و سيتم التعديل مباشرة فى ملف الاخ M.hindawi و هذا سيفيدك عند كتابة اي اسم جديد و يمكنك نقل الوحدات النمطية الي ملف بياناتك فى نفس اماكنها لاستخدامها فى ملف آخر فالدالة الرئيسية مكتوبة فى موديول و الاستدعاء العام للتنفيذ مكتوب فى مكان كتابة الموديول الخاص بالملف و لتنفيذ ذلك افتح ملفك مع الملف الحالي اضغط ALT + F11 سيظهر محرر الكود و به الملفان المفتوحان اختر الموديول الموجود فى الملف و اسحبه الي ملفك انقر علي workbook فى ملف Hamza ستجد كود قم بنسخه ثم انقر مرتين علي كلمة workbook في ملفك ثم قم بلصق نفس الكود و بذلك يكون ملفك مجهزا لاستبدال اي اسم تكتبه اليا و اعتقد انك قد تريد انك تريد تغيير بعض الاسماء الموجودة فى ملفك اصلا و التي لن تتأثر بما سبق الا عند اعادة كتابتها او تحريرها لذا ستجد فى الملف المرفق هنا الخيار الاخر و هو ان تختار بعد الخلايا المكتوبة بالفعل علي ان يكون الاختيار من اعلي الي اسفل ثم تضغط ALT+F8 ليظهر لك الماكرو الجديد الذي بتشغيله يتم تغيير الخلايا المكتوبة بالفعل و ايضا يمكنك نسخ الماكرو الي اي ملف او هنا لانك فى الغالب ستسخدمه مرة واحدة فقط يمكنك فتح الملف المرفق مع اي ملف و سيعمل الماكرو باذن الله دون نقله شرط ان يكون المفان مفتوحان آنيا Sub changeletters() Dim a As String, rowcount As Integer rowcount = Selection.Rows.Count For i = 1 To rowcount a = Selection.Cells(i).Value Selection.Cells(i).Value = changesearch(a) Next i End Sub و الدالة كما سبق فى ملف الاخ هنداوي Public Function changesearch(Mytxt) As String Dim tempstr As String tempstr = Trim(Mytxt) If tempstr Like "*[أاآإ]*" Then For b = 1 To Len(tempstr) If Mid(tempstr, b, 1) = "ا" Or Mid(tempstr, b, 1) = "إ" Or Mid(tempstr, b, 1) = "أ" Or Mid(tempstr, b, 1) = "آ" Then Mid(tempstr, b, 1) = "ا" Else End If Next End If If tempstr Like "*[ةه]*" Then For b = 1 To Len(tempstr) If Mid(tempstr, b, 1) = "ة" Or Mid(tempstr, b, 1) = "ه" Then Mid(tempstr, b, 1) = "ه" Else End If Next End If If tempstr Like "*[ىي]*" Then For b = 1 To Len(tempstr) If Mid(tempstr, b, 1) = "ى" Or Mid(tempstr, b, 1) = "ي" Then Mid(tempstr, b, 1) = "ي" Else End If Next End If changesearch = tempstr End Function و التعميم لتفيذ الدالة علي اي خلية فى الملف عند كتابتها او تحريرها - اي تغيير محتوياتها Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim a As String a = Cells(Target.Row, Target.Column).Text Target = changesearch(a) End Sub مرفق الملف و به الاثنان التعميم عند تغير قيمة اي خلية و الماكرو لتعديل القيم الموجودة اصلا hamza2.zip 1
m.hindawi قام بنشر سبتمبر 22, 2005 قام بنشر سبتمبر 22, 2005 بسم الله الرحمن الرحيم اخي محمد طاهر شكرا على مداخلتكم وفعلا السطر الذي اشرت اليه يمكن حذفه بدون ان تتاثر الدالة يبدو انه سقط سهوا مني لاني كنت في عجلة من امري والغداء كان ينتظرني وانت كما تعلم فان الجوع صعب شكرا لك وانشا الله الفائدة تعم الجميع
أحمد سعيد قام بنشر سبتمبر 24, 2005 الكاتب قام بنشر سبتمبر 24, 2005 لا أدرى كيف أشكركم على ما تقومون به جزاكم الله خيرا وسوف أقوم بتجريب الأمر مرة ثانية بعد أن أفهم كلام المهندس محمد طاهر ( حفظه الله ) لأننى يبدوا أن هناك شيئ ما لاأفهمه من الكلام فمعذرة فأنا ما زلت فى أول الطريق حيث أننىقمت بفتح الملف المرسل من الأخ هنداوى وأخذت البيانات الموجود عندى فى الملف الآخر ووجدته قد قام بتغيير جميع الأسماء وأصبحت كلها إسم واحد فقط تحياتى لكم جميعا
محمد طاهر عرفه قام بنشر سبتمبر 25, 2005 قام بنشر سبتمبر 25, 2005 أخي احمد خدها خطوة خطوة اولا افتح آخر ملف ارفقته جرب الكتابة فيه ، ستجد ما تكتب يتعدل تلقائيا ثانيا افتح ملفك الاصلي مع ابقاء الملف hamza2 مفتوحا ثم اختار الخلايا فى عمود واحد فى ملفك من اعلي الي اسفل ثم شغل الماكرو من قائمة Tools Macro او من ALT+F8 ستجد بياناتك تتعدل فاذا كان ذلك صحيحا فراجع بعد ذلك كيفية نقل الكود الي ملفك من الشرح السابق او ايضا من هنا http://www.officena.net/ib/index.php?showtopic=3069
أحمد سعيد قام بنشر سبتمبر 26, 2005 الكاتب قام بنشر سبتمبر 26, 2005 الحمد لله قد تم الأمر على خير بارك الله فيك وفى منتداكم الرائع وجعل الله ذلك ذخراً لكم يوم الدين وجزاكم الله خيراً والسلام عليكم ورحمة الله وبركاته وأنا آسف على التعب الذى تسببته لكم
الردود الموصى بها