自动计算计算式

经验创意 · 78 次浏览
Ulookperfect... 创建于 2025-02-10 17:51



Sub CalculateFormulas()
    Dim selectedRange As Range
    Dim cell As Range
    Dim result As Double
    Dim formulaStr As String
    Dim regEx As Object
    
   '获取当前选中的区域
    Set selectedRange = Selection
    
   '创建正则表达式对象
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Pattern = "[^0-9+\-*/.^]" '修改正则表达式模式,保留幂运算符号^
    regEx.Global = True
    
   '遍历选中区域的每个单元格
    For Each cell In selectedRange.Cells
       '获取单元格内容作为计算式
        formulaStr = cell.Value
       '使用正则表达式替换掉非数字和运算符的字符
        formulaStr = regEx.Replace(formulaStr, "")
        
       '处理可能存在的连续的幂运算符号情况,例如2^2^2
       Do While InStr(formulaStr, "^") > 0
            Dim pos As Integer
            pos = InStr(formulaStr, "^")
            Dim leftNum As Double
            Dim rightNum As Double
            leftNum = CDbl(Split(Mid(formulaStr, 1, pos - 1), "*")(UBound(Split(Mid(formulaStr, 1, pos - 1), "*"))))
            rightNum = CDbl(Split(Mid(formulaStr, pos + 1), "*")(0))
            Dim tempResult As Double
            tempResult = leftNum ^ rightNum
            formulaStr = Replace(formulaStr, Mid(formulaStr, pos - 1, Len(CStr(leftNum)) + Len(CStr(rightNum)) + 1), CStr(tempResult))
        Loop
        
       '使用 Evaluate 函数计算表达式结果
        On Error Resume Next
        result = Evaluate(formulaStr)
        On Error GoTo 0
        
       '如果计算成功,将结果写入右侧单元格
        If Err.Number = 0 Then
            cell.Offset(0, 1).Value = result
        Else
            cell.Offset(0, 1).Value = "计算错误"
        End If
    Next cell
    
    Set selectedRange = Nothing
    Set cell = Nothing
    Set regEx = Nothing
End Sub


回复内容
暂无回复
回复主贴