函数实现帐本计数及大写金额（方法二则）

tanhong

一、实现金额大写，解决单元格特殊格式中＂中文大写数字＂实现数字的大写，无法转换成为金额的元角分的问题．
二、实现仿帐面计数格式（见下图）


实例下载：

方法二在六楼下载

[ 本帖最后由 tanhong 于 2008-3-19 16:17 编辑 ]

tanhong

原帖由 pureshadow 于 2008-3-19 13:30 发表
嘿嘿......试用过隐藏函数吗,公式可以短很多哟......
用NUMBERSTRING
先不公布
江版动脑筋自己做一个

哈哈!小妖卖关子.考我哦
好,我做一个,下午教卷

tanhong

小妖完成你下达的任务．用隐藏函数做的，实现金额大写函数，不知道是不是符合要求，你有什么更好的办法，帖出来哦．
下面是我写的函数．
=IF(ISERR(SEARCH(".",C3))=FALSE,NUMBERSTRING(INT(C3),2)&"元" &IF(LEN(C3)-SEARCH(".",C3)=1,NUMBERSTRING(RIGHT(C3,1),2) &"角整",NUMBERSTRING(LEFT(RIGHT(C3,2),1),2) &"角"& NUMBERSTRING(RIGHT(C3,1),2) &"分"),NUMBERSTRING(INT(C3),2)&"元整")

见下图：

实例二：

tanhong

小妖提示对，我还少了四舍五入，小妖给出了一个更简便的方法(见如下公式)：

="人民币:"&NUMBERSTRING(ROUNDDOWN(C3,0),2)&"元"&NUMBERSTRING(ROUNDDOWN(MOD(C3*100,100)/10,0),2)&"角"&NUMBERSTRING(MOD(C3*100,10),2)&"分"

tanhong

我也再凑个函数:
Public Function HZtoALB(strHZ As String) As Double
    Dim strTemp As String
    Dim lngPosition As Long
    Dim lngYi As Long
    Dim lngW As Long
    Dim lngQ As Long
    Dim lngB As Long
    Dim lngS As Long
    Dim lngY As Long
    Dim sngJ As Single
    Dim sngF As Single
    '截取亿部份
    lngPosition = InStr(1, strHZ, "亿")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
       lngYi = JQ(strTemp) * 100000000
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取万部份
    lngPosition = InStr(1, strHZ, "万")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngW = JQ(strTemp) * 10000
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取仟部份
    lngPosition = InStr(1, strHZ, "仟")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngQ = JQ(strTemp) * 1000
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取佰部份
    lngPosition = InStr(1, strHZ, "佰")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngB = JQ(strTemp) * 100
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取拾部份
    lngPosition = InStr(1, strHZ, "拾")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngS = JQ(strTemp) * 10
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取元部份
    lngPosition = InStr(1, strHZ, "元")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngY = JQ(strTemp) * 1
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取角部份
    lngPosition = InStr(1, strHZ, "角")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        sngJ = JQ(strTemp) * 0.1
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取分部份
    lngPosition = InStr(1, strHZ, "分")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        sngF = JQ(strTemp) * 0.01
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
   HZtoALB = lngYi + lngW + lngQ + lngB + lngS + lngY + sngJ + sngF
End Function
'计算每一段数值
Public Function JQ(strZ As String) As String
    Dim lngPosition As Long
    Dim strTemp As String
    Dim lngTemp As Long
    lngPosition = InStr(1, strZ, "仟")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strZ, lngPosition - 1, 1)
       lngTemp = GetArabia(strTemp) * 1000
    End If
    lngPosition = InStr(1, strZ, "佰")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strZ, (lngPosition - 1), 1)
       lngTemp = lngTemp + GetArabia(strTemp) * 100
    End If
    lngPosition = InStr(1, strZ, "拾")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strZ, lngPosition - 1, 1)
       lngTemp = lngTemp + GetArabia(strTemp) * 10
    End If
   strTemp = Right(strZ, 1)
   lngTemp = lngTemp + GetArabia(strTemp) * 1
    JQ = lngTemp
End Function

'转换汉字数字为阿拉伯数字
Public Function GetArabia(strZ As String) As Long
    Select Case strZ
        Case "壹"
           GetArabia = 1
        Case "贰"
           GetArabia = 2
        Case "叁"
           GetArabia = 3
        Case "肆"
           GetArabia = 4
        Case "伍"
           GetArabia = 5
        Case "陆"
           GetArabia = 6
        Case "柒"
           GetArabia = 7
        Case "捌"
           GetArabia = 8
        Case "玖"
           GetArabia = 9
        Case "零"
           GetArabia = 0
    End Select
End Function