كود استبدال قيم داخل جميع الصفحات مطلوب تحويلة لصفحة واحدة

[elzaem_yousif]

زملائى الاعزاء والسادة الخبراء

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

المطلوب تحويلة ليكون داخل الصفحة الحالية فقط

ارجو منكم التعديل المطلوب ليكون داخل الـ sheet الذى يتم فيه اجراء الماكرو فقط 

Sub Button1_Click()

'PURPOSE: Find & Replace a list of text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("Absent ", "Trainer", "Trainer ", "Op_Training", "Op_Training ", "Peer_mentor", "Peer_mentor ", "Annual ", "Forced_Annu", "Forced_Annu ", "Avl_Annual", "Avl_Annual ", "Emergency ", "Sick ", "Planned_Sic", "Planned_Sic ", "Army", "Army ", "Planned_Arm", "Planned_Arm ", "Maternity", "Maternity ", "Bereavement", "Bereavement ")
rplcList = Array("Absent", "HR", "HR", "HR", "HR", "HR", "HR", "Annual", "Annual", "Annual", "Annual", "Annual", "Emergency", "Sick", "Sick", "Sick", "Other", "Other", "Other", "Other", "Other", "Other", "Other", "Other")

'Loop through each item in Array lists
  For x = LBound(fndList) To UBound(fndList)
    'Loop through each worksheet in ActiveWorkbook
      For Each sht In ActiveWorkbook.Worksheets
        sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      Next sht
  
  Next x
 MsgBox "Replacemnt Done Sucssefully", 0, "Mohamed Youssef 11674"
End Sub

 

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

أخي الكريم

إن شاء الله طلبك سهل ويسير فقط ارفق ملف للعمل عليه

Sub Button1_Click()

'PURPOSE: Find & Replace a list of text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("Absent ", "Trainer", "Trainer ", "Op_Training", "Op_Training ", "Peer_mentor", "Peer_mentor ", "Annual ", "Forced_Annu", "Forced_Annu ", "Avl_Annual", "Avl_Annual ", "Emergency ", "Sick ", "Planned_Sic", "Planned_Sic ", "Army", "Army ", "Planned_Arm", "Planned_Arm ", "Maternity", "Maternity ", "Bereavement", "Bereavement ")
rplcList = Array("Absent", "HR", "HR", "HR", "HR", "HR", "HR", "Annual", "Annual", "Annual", "Annual", "Annual", "Emergency", "Sick", "Sick", "Sick", "Other", "Other", "Other", "Other", "Other", "Other", "Other", "Other")

'Loop through each item in Array lists
  For x = LBound(fndList) To UBound(fndList)
    'Loop through each worksheet in ActiveWorkbook
      'For Each sht In ActiveWorkbook.Worksheets
        ActiveSheet.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      'Next sht
  
  Next x
 MsgBox "Replacemnt Done Sucssefully", 0, "Mohamed Youssef 11674"
End Sub

تقبل تحياتي

[elzaem_yousif]

مرفق ملف للعمل علية

به 3 ورقات عمل

الورقة الثانية والثالثة بها زر ملحق به ماكرو الكود المذكور

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

فما هو التعديل على الماكرو بحث يقتصر على الورقة النشطة فقط او الورقة التى ينفذ بها الماكرو

اقتباس

هل لو حذفت السطور التالية مثلا يصبح الماكرو للصفحة الحالية ؟؟؟؟

    'Loop through each worksheet in ActiveWorkbook
      'For Each sht In ActiveWorkbook.Worksheets
        ActiveSheet.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      'Next sht

 

Jan 2016.zip

تم تعديل أبريل 28, 2016 بواسطه elzaem_yousif

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

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

هل جربت الكود في مشاركتي السابقة قبل الرد ..؟ وإذا كنت جربته فهل حدثت معك مشكلة؟

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

بالنسبة لسؤالك : نعم بالنسبة للسطور التي وضعت عليها تعليق هي أسطر مسئولة عن عمل حلقة تكرارية لكل أوراق المصنف ، فقمت بوضع تعليق عليها ، واستبدلت المتغير المسمى Sh والذي يشير لكل ورقة عمل بكلمة ActiveSheet للإشارة إلى ورقة العمل النشطة

يرجى إفادتنا بالنتائج

تقبل تحياتي