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

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

sfs777

收了！！！！！！！！！！！！

yjh16_mail

好例子, 学习！！

wudi886

rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr

joyark

谢谢 楼主 的分享

刘青梅

好例子, 学习！！