استبدال النطاقات المسماة في المعادلات بمرجع الخلية الأصلي Replace Named Ranges With Cell References In Formulas

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

إليكم كود يقوم بالبحث في المعادلات في ورقة العمل ويستبدل النطاقات المسماة Named Ranges بمرجع الخلية الأصلي ، وبعد الانتهاء من عمليات الاستبدال يتم حذف كافة النطاقات المستخدمة.

أي بفرض أن الخلية A1 تمت تسميتها باسم Price ، والخلية A2 تمت تسميتها باسم Amount .. ثم في الخلية A3 أردت حساب السعر في الكمية ، فيمكنك كتابة المعادلة ببساطة بهذا الشكل كما هو موضح بالصورة التالية :

 

المطلوب الآن أن يتم استبدال النطاق المسمى في المعادلة بالمرجع الأصلي لها أي استخدام مرجع الخلية A1 بدلاً من النطاق المسمى Price ، واستبدال مرجع الخلية A2 بدلاً من النطاق المسمى Amount ، ليكون بهذا الشكل :

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

وبعد الانتهاء من عمليات الاستبدال يتم حذف كافة النطاقات المسماة Named Ranges ، والتي يمكن الوصول إليها عن طريق التبويب Formulas ثم Name Manager 

وأخيراً إليكم الكود المستخدم لتنفيذ المهمة

Sub ConvertNamedRangesToCellReference()
    Dim Nm As Name, Str As String
    Dim Cel As Range
    
    Application.ScreenUpdating = False
        For Each Cel In ActiveSheet.UsedRange
            If Cel.HasFormula Then
                Str = Cel.Formula
                For Each Nm In Names
                    If InStr(Str, Nm.Name) Then
                        Str = Replace(Str, Nm.Name, Mid(Nm.RefersTo, 2))
                        Str = Replace(Str, "$", "")
                    End If
                Next Nm
                Cel.Formula = Str
            End If
        Next Cel
        
        For Each Nm In Names
            Nm.Delete
        Next Nm
    Application.ScreenUpdating = False
    
    MsgBox "Done...", 64
End Sub

تحميل الملف من هنا

إعداد /  ياسر خليل أبو البراء