金额转换，小写转大写，特殊格式

853447825

现已有小写转大写的格式，但是想进一步升级公式，有大神改一下吗？升级后格式如图所示。
公式原代码:
Function 金额转换(金额 As String, Optional 转换类型 As Boolean = False)
'自定义函数 -【金额转换】函数     金额转换(【第一参数】,【第二参数】)
'【功能】: 人民币大写小写互相转化
'【第一参数】金额(可为单元格或字符串)
'【第二参数】转换类型(为可选参数)，当值为False(0)或者省略时表示小写转大写；当为值为True(1)时表示大写转小写；默认值为0(小写转大写)
'【注意】  大写转小写时,金额为大写的字符串形式时,要在金额两边加【""】,如："壹万叁仟柒佰玖拾叁元整"
If Len(金额) = 0 Then 金额转换 = "": Exit Function
If 转换类型 = False And Not IsNumeric(金额) Then 金额转换 = "": Exit Function
If 转换类型 = True And IsNumeric(金额) Then 金额转换 = "": Exit Function
If 转换类型 = False Then
Dim RMBS As String
If 金额 = 0 Then 金额转换 = "零元整": Exit Function
RMBS = Replace(Replace(Application.Text(Round(金额, 2), "[DBnum2]"), ".", "元"), "-", "负")
RMBS = IIf(Left(Right(RMBS, 3), 1) = "元", Left(RMBS, Len(RMBS) - 1) & "角" & Right(RMBS, 1) & "分", IIf(Left(Right(RMBS, 2), 1) = "元", RMBS & "角", IIf(RMBS = "零", "", RMBS & "元整")))
RMBS = Replace(Replace(RMBS, "零元", ""), "零角", "")
金额转换 = RMBS
Else
Dim i As Byte, Style As Boolean, j As Byte, k As Byte, l As Byte, f As Byte
Style = True
f = InStr(金额, "负")
If f <> 0 Then 金额 = Replace(金额, "负", "")
金额 = Replace(Replace(Replace(Replace(金额, "整", ""), "亿", ")亿"), "万", ")万"), "兆", ")兆")
j = InStr(金额, "兆")
If j > 0 Then 金额 = "(" & 金额
k = InStr(金额, "亿")
If k > 0 Then 金额 = "(" & 金额
l = InStr(金额, "万")
If l > 0 Then 金额 = Left$(金额, k + IIf(k > 0, 1, 0)) & "(" & Right$(金额, Len(金额) - k - IIf(k > 0, 1, 0))
金额 = Replace(金额, "兆", "万")
For i = 1 To 11
金额 = Replace(金额, Mid("零壹贰叁肆伍陆柒捌玖 ", i, 1), i - 1)
金额 = Replace(金额, Mid("分角元拾佰仟万亿", i, 1), "*" & (10 ^ (i - 3)) & "+")
Next
金额 = Replace(Replace(金额, "+)", ")"), "+*", "*")
If f = 0 Then
    金额转换 = Evaluate(Left(金额, Len(金额) - 1))
Else
    金额转换 = "-" & Evaluate(Left(金额, Len(金额) - 1))
End If
End If
End Function

少如

     帮顶一下, 看看有不有大神出手.

853447825

有没有大神出手呀

libo5563

vba 不会，函数应该有公式，比较难，写不出来，用power query来凑个数