基于excel计算结果返回计算公式的函数

我是结构设计工程师，大量计算是用excel进行，为方便计算结果贴图作为计算书，需要将单元格计算结果展开为公式显示出来，其中的引用单元格对象也需要转换为对应数值，因此做了一个函数，输入项是计算结果，返回公式。若计算过程最外层套用round函数，会将round函数隐去。支持位置引用以及自定义名称引用。

应用，E3

Public Function xqzde(ans As Range) As String
    ' de for display equation
    Dim formulastring As String
    Dim innerformula As String
    ' 读取单元格(公式形式)
    formulastring = ans.formula

    '1. 替换常用自定函数π以及绝对位置引用符号
    formulastring = Replace(formulastring, "$", "")
    formulastring = Replace(formulastring, "Pi()", "3.14")
    formulastring = Replace(formulastring, "pi()", "3.14")
    formulastring = Replace(formulastring, "PI()", "3.14")


    '2. 识别外层round函数，有则删除
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True    '全局匹配
    regex.IgnoreCase = True    '忽略大小写
    'round\((.*)\)$要拆解为 "round\(" 、 "(.*)" 、 "\)$"三部分
    '"round\(表示匹配字符串"round("，这里\(表示对做括号(转义，因为括号有特殊含义
    '(.*)表示匹配任意字符零次或多次，括号()表示一个捕获组，捕获匹配的内容；"."表示任意单个字符（除换行符），"*"表示前面模式可以出现零次或多次
    '\)$表示匹配字符串)并且$表示字符串的结尾，\)是对）进行转义
    regex.pattern = "round\((.*)\)$"
    Set matches = regex.Execute(formulastring)
    '执行匹配，返回一个matchcollection对象，含所有匹配结果，每一个匹配结果是一个match对象，含匹配的字符串、位置、长度以及捕获组
    'matches.count 为匹配结果的序数组，从0开始
    'match.value 为匹配值
    'match.firstindex为匹配的起始位置
    'match.length为匹配的长度
    If matches.Count > 0 Then
        innerformula = matches(0).SubMatches(0)
        commaposition = InStr(innerformula, ",")
        innerformula = "=" & Left(innerformula, commaposition - 1)
    Else
        innerformula = formulastring ' 如果没有找到 round 函数，返回原始公式
    End If
    formulastring = innerformula

    '3. 识别公式中的自定义名称并进行替换
    Dim nm As name
    Dim namesArray() As Variant
    Dim prefixpos As Integer
    Dim cusname As String
    Dim cellvalue As String
    Dim temp As Variant
    Dim isSorted As Boolean

    ReDim namesArray(1 To ws.Names.Count, 1 To 2)
    i = 1

    ' 3.1  遍历名称管理器中的所有名称
    For Each nm In ws.Names
        ' 检查名称是否属于指定的工作表
        If nm.Parent.name = ws.name Then
            ' 存储名称及其长度
            namesArray(i, 1) = nm.name
            namesArray(i, 2) = Len(nm.name)
            i = i + 1
        End If
    Next nm

    ' 调整数组大小以适应实际名称数量
    ReDim Preserve namesArray(1 To i - 1, 1 To 2)

    ' 使用冒泡排序算法按名称长度排序（先长后短）
    For j = LBound(namesArray, 1) To UBound(namesArray, 1) - 1
        isSorted = True
        For i = LBound(namesArray, 1) To UBound(namesArray, 1) - 1
            If namesArray(i, 2) < namesArray(i + 1, 2) Then
                ' 交换名称和长度
                temp = namesArray(i, 1)
                namesArray(i, 1) = namesArray(i + 1, 1)
                namesArray(i + 1, 1) = temp

                temp = namesArray(i, 2)
                namesArray(i, 2) = namesArray(i + 1, 2)
                namesArray(i + 1, 2) = temp

                isSorted = False
            End If
        Next i
        If isSorted Then Exit For
    Next j

    ' 处理排序后的名称
    For i = LBound(namesArray, 1) To UBound(namesArray, 1)
        Set nm = ThisWorkbook.Names(namesArray(i, 1))
        
        ' 检查名称是否属于指定的工作表
        If nm.Parent.name = ws.name Then
            ' 处理名称中的 "!" 前缀
            prefixpos = InStr(nm.name, "!")
            If prefixpos > 0 Then
                cusname = Mid(nm.name, prefixpos + 1)
            Else
                cusname = nm.name
            End If

            ' 获取名称对应的单元格值
            cellvalue = CStr(Range(nm.refersTo).Value)

            ' 替换公式字符串中的名称
            formulastring = Replace(formulastring, cusname, cellvalue)
        End If
    Next i


    '4. 识别公式中的位置引用（字母+数字的模式）并进行替换
    'pattern 正则表达式的识别模式 [A-Z]+\d+分为两部分"[A-Z]+"和"\d+"两部分
    '[A-Z]表示匹配一个A到Z范围内大写字母，+表示该模式可以出现一次或者多次，即识别A、AB、ABC、XYZ等等
    '\d表示匹配一个数字字符，相当于[0-9],+表示该模式可以出现一次或者多次，即识别1、12、045等等
    '两部分配合起来便成了识别单元格位置的模式，如果自定义名称中出现类似X1_，那么也会因为出现X1被识别为单元格位置，所以不要用字母数字组合进行自定义名称
    regex.pattern = "([A-Z]+\d+)"
    Set matches = regex.Execute(formulastring)
    foundformula = formulastring
    For i = 0 To matches.Count - 1
        ' 获取单元格引用
        Set cellRef = ws.Range(matches(i).SubMatches(0))
        
        ' 获取单元格的值
        If IsNumeric(cellRef.Value) Then
            cellvalue = CStr(cellRef.Value)
        Else
            cellvalue = """" & cellRef.Value & """" ' 如果值是字符串，添加双引号
        End If

        ' 将单元格引用替换为对应的值
        foundformula = Replace(foundformula, matches(i).Value, cellvalue)
    Next i

    xqzde = foundformula & "="
End Function

为计算结果单元格，A3单元格=xqzde(E3)