اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

عمل ماكرو لحل مشكلة الهمزة


الردود الموصى بها

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

بارك الله فيكم وفى مجهوداتكم الرائعة جعل الله ذلك نورا لكم على الصراط يوم تزل الأقدام

إخوانى لى طلب بسيط وهو

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

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

وجزاكم الله خيرا كثيرا

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

رابط هذا التعليق
شارك

يا هلا :(

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

و يتم فيه استبدال ال أ و ا و آ و إ ب ا

و ال ة و ال ه ب ه

و ال ي و ال ى ب ي

تاكد من تفعيل الماكرو ( مستوي الامان قبل فتح الملف ) :pp:

ملاحظة : تم تعديل الملف فى مشاركة لاحقة للاخ m.hindawi

رابط هذا التعليق
شارك

وعليكم السلام ورحمة الله وبركاته أخى الفاضل محمد

أولا جزاك الله خيرا على الرد السريع

لكن أخى الحبيب الملف لايؤدى إلى أى نتائج صحيحة حيث أن ما به عبارة عن معادلة changesearch(A2)

وأنت تعلم أن هذا ليس هو المطلوب

أرجوكم إخوانى الكرام أن تساعدونى فى هذا الأمر حيث أننى فى مسيس الحاجة إليه

وسوف يكون ذلك فى ميزان الحسان يوم القيامة

رابط هذا التعليق
شارك

يا اخي راجع الجملة السابقة

تاكد من تفعيل الماكرو ( مستوي الامان قبل فتح الملف )

لكي تعمل الدوال التي اعدها المستخدم

User defined functions

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

و ذلك من

Tools

Macro

security

و اختار Medium ليعمل مباشرة

او Medium ليخيرك

و بعد ذلك افتح الملف

و بالتالي ستعمل الدالة

و بكتابة اسم فى العمود الاول سينتج الاسم الجديد فى العمود الثاني

و يمكنك سحب المعادلة لاي عدد من الخلايا

يعني هذه دالة تعمل مثل دالة sum مثلا

و لكن لابد من السماح بعمل الماكرو كما سبق

رابط هذا التعليق
شارك

السلام عليكم

آسف للإزعاج الشديد لكم

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

أحمد سعيد

أحمد السيد

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

أرجو سرعة الرد لشديد الإحتياج

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

رابط هذا التعليق
شارك

بسم الله الرحمن االرحيم

اخي الكريم الدالة تعمل جيدا

اما بالنسبة الى التكرار فذلك طبيعي

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

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

ملاحظة : تم تعديل الملف فى مشاركة لاحقة للاخ m.hindawi

رابط هذا التعليق
شارك

بسم الله الرحمن الرحيم

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

وانتظر ردي

شكرا لك

رابط هذا التعليق
شارك

بسم الله الرحمن الرحيم

الموضوع كان بسيط ولم يحتج جهدا كبيرا

على فكرة الدالة معممة وما عليك الا ان تكتب بالملف وفي اي خلية

دون الحاجة لادراج دالة في خلية معينة

جرب واعلمني بالنتيجة

ملاحظة : تم تحديث الملف فى المشاركة التالية

رابط هذا التعليق
شارك

جزاك الله خيرا اخي 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

  • Thanks 1
رابط هذا التعليق
شارك

بسم الله الرحمن الرحيم

اخي محمد طاهر

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

شكرا لك

وانشا الله الفائدة تعم الجميع

رابط هذا التعليق
شارك

لا أدرى كيف أشكركم على ما تقومون به

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

وسوف أقوم بتجريب الأمر

مرة ثانية بعد أن أفهم كلام المهندس محمد طاهر ( حفظه الله ) لأننى يبدوا أن هناك شيئ ما لاأفهمه من الكلام

فمعذرة فأنا ما زلت فى أول الطريق

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

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

رابط هذا التعليق
شارك

أخي احمد

خدها خطوة خطوة

اولا افتح آخر ملف ارفقته

جرب الكتابة فيه ، ستجد ما تكتب يتعدل تلقائيا

ثانيا

افتح ملفك الاصلي مع ابقاء الملف hamza2 مفتوحا

ثم اختار الخلايا فى عمود واحد فى ملفك من اعلي الي اسفل

ثم شغل الماكرو

من قائمة

Tools

Macro

او من

ALT+F8

ستجد بياناتك تتعدل

فاذا كان ذلك صحيحا

فراجع بعد ذلك كيفية نقل الكود الي ملفك من الشرح السابق

او ايضا من هنا

http://www.officena.net/ib/index.php?showtopic=3069

رابط هذا التعليق
شارك

الحمد لله

قد تم الأمر على خير

بارك الله فيك وفى منتداكم الرائع وجعل الله ذلك ذخراً لكم يوم الدين

وجزاكم الله خيراً والسلام عليكم ورحمة الله وبركاته وأنا آسف على التعب الذى تسببته لكم

رابط هذا التعليق
شارك

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information