Office中国论坛/Access中国论坛
标题: [转帖]将汉字大写数字转换为阿拉伯数字的函数 [打印本页]
作者: zhuyiwen 时间: 2002-7-22 05:00
标题: [转帖]将汉字大写数字转换为阿拉伯数字的函数
作者: 黄河[4326340] 2001-04-29 18:18:18
'思路:
'1、将汉字金额字串截为:亿、万、仟、伯、拾、元、角、分捌个部份
'2、分别处理各部份数据,完成后亿部份乘以100000000,万部份乘以10000,仟部分乘以1000,佰部分乘以100,拾部份乘以10,元部部不处理,角部份乘以0.1,分部份乘以0.01.
'3、把各部份相加并输出
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 "肆"
Ge
作者: zhuyiwen 时间: 2002-7-22 05:13
标题: [转帖]VB中返回货币的英文大写的原代码
作者: 欧阳峰[48121454] 2001-05-03 00:03:11
以上是本人在实际编程中返回货币的英文大写的原代码
调用函数为getcapital(stra as string),请各位大虾指点
Public Function strten(strt As String) As String
Dim strdim As String
Select Case Trim(strt)
Case "0", "00"
strdim = "ZERO"
Case "1"
strdim = "ONE"
Case "2"
strdim = "TWO"
Case "3"
strdim = "THREE"
Case "4"
strdim = "FOUR"
Case "5"
strdim = "FIVE"
Case "6"
strdim = "SIX"
Case "7"
strdim = "SEVEN"
Case "8"
strdim = "EIGHT"
Case "9"
strdim = "NINE"
Case "10"
strdim = "TEN"
Case "11"
strdim = "ELEVEN"
Case "12"
strdim = "TWELEVE"
Case "13"
strdim = "THIRTEEN"
Case "14"
strdim = "FOURTEEN"
Case "15"
strdim = "FIFTEEN"
Case "16"
strdim = "SIXTEEN"
Case "17"
strdim = "SEVENTEEN"
Case "18"
strdim = "EIGHTEEN"
Case "19"
strdim = "NINETEEN"
Case "20"
strdim = "TWENTY"
Case "30"
strdim = "THIRTY"
Case "40"
strdim = "FORTY"
Case "50"
strdim = "FIFTY"
Case "60"
strdim = "SIXTY"
Case "70"
strdim = "SEVENTY"
Case "80"
strdim = "EIGHTY"
Case "90"
strdim = "NINETY"
End Select
strten = strdim
End Function
Public Function strth(strb As String) As String
If Val(strb) <= 20 Then
strth = strten(strb)
Else
strth = strten(Left(strb, 1) & "0") & " " & strten(Right(strb, 1))
End If
End Function
Public Function getcapital(stra As String) As String
Dim strRe As String
strRe = ""
stra = Format(stra, "###########0.00")
If StrComp(Right(stra, 2), "00") <> 0 Then strRe = " AND CENTS " & strth(Right(stra, 2))
stra = Left(stra, Len(Trim(stra)) - 3)
If Len(stra) >= 2 Then
strRe = strth(Right(stra, 2)) & strRe
stra = Left(stra, Len(Trim(stra)) - 2)
Else
strRe = strth(Right(stra, 1)) & strRe
stra = ""
End If
If Len(stra) <= 0 Then
Convision = strRe
Exit Function
End If
strRe = strth(Right(stra, 1)) & " HUNDRED " & strRe
stra = Left(stra, Len(Trim(stra)) - 1)
If Len(stra) <= 0 Then
Convision = strRe
Exit Function
End If
strRe = " THOUSAND " & strRe
If Len(stra) >= 2 Then
strRe = strth(Right(stra, 2)) & strRe
stra = Left(stra, Len(Trim(stra)) - 2)
Else
strRe = strth(Right(stra, 1)) & strRe
stra = ""
End If
If Len(stra) <= 0 Then
Convision = strRe
Exit Function
End If
strRe = " HUNDRED " & strRe
strRe = strth(Right(stra, 1)) & strRe
stra = Left(stra, Len(stra) - 1)
If Len(stra) <= 0 Then
Convision = strRe
Exit Function
End If
strRe = " THOUSAND " & strRe
If Len(stra) >= 2 Then
strRe = strth(Right(stra, 2)) & strRe
stra = Left(stra, Len(Trim(stra)) - 2)
Else
strRe = strth(Right(stra, 1)) & strRe
stra = Left(stra, Len(Trim(stra)) - 1)
End If
If Len(stra) <= 0 Then
Convision = strRe
Exit Function
ElseIf Len(stra) <= 2 Then
Convision = strth(stra) & " HUNDRED " & strRe
Exit Function
Else
MsgBox "数据超出范围", vbOKOnly, "information"
End If
End Function
[em26]
作者: ui 时间: 2002-7-22 05:17
好好,现在转来转去都齐了
作者: HG 时间: 2002-7-22 20:09
标题: 可是它是個不能用的呀!
老朱多謝!我的英文金額轉換程式一直都有一個小錯誤,就是不能在循環中判斷,並合理的按三位來值,因最有些忙,所以也沒調試了,今天你轉了這貼,我也不想去調試了,拿來主義.多多謝!
這個英文的金額轉換是不能用的,應該是個半成品吧?
[此贴子已经被HG于2002-7-22 12:09:21编辑过]
作者: HG 时间: 2002-7-22 21:03
天呀,歐陽峰,我敢嗎?我又不是黃老邪.
誰想看看我的英文金額轉換代碼,幫我改一改.
現在的情況是,只能轉換長度為三的倍數的金額.如長度為3們以下,6,9,12都可以,
但4位,5,7,8位還有bug.
作者: zhuyiwen 时间: 2002-8-3 19:22
此函数的确存在问题,请勿用。如有能者,请辅正。现更正没有结果返回的错误,另,其中算法及范围有问题。
Public Function strTen(strT As String) As String
Dim strDim As String
Select Case Trim(strT)
Case "0", "00"
strDim = "ZERO"
Case "1"
strDim = "ONE"
Case "2"
strDim = "TWO"
Case "3"
strDim = "THREE"
Case "4"
strDim = "FOUR"
Case "5"
strDim = "FIVE"
Case "6"
strDim = "SIX"
Case "7"
strDim = "SEVEN"
Case "8"
strDim = "EIGHT"
Case "9"
strDim = "NINE"
Case "10"
strDim = "TEN"
Case "11"
strDim = "ELEVEN"
Case "12"
strDim = "TWELEVE"
Case "13"
strDim = "THIRTEEN"
Case "14"
strDim = "FOURTEEN"
Case "15"
strDim = "FIFTEEN"
Case "16"
strDim = "SIXTEEN"
Case "17"
strDim = "SEVENTEEN"
Case "18"
strDim = "EIGHTEEN"
Case "19"
strDim = "NINETEEN"
Case "20"
strDim = "TWENTY"
Case "30"
strDim = "THIRTY"
Case "40"
strDim = "FORTY"
Case "50"
strDim = "FIFTY"
Case "60"
strDim = "SIXTY"
Case "70"
strDim = "SEVENTY"
Case "80"
strDim = "EIGHTY"
Case "90"
strDim = "NINETY"
End Select
strTen = strDim
End Function
Public Function strTh(strB As String) As String
If Val(strB) <= 20 Then
strTh = strTen(strB)
Else
strTh = strTen(Left(strB, 1) & "0") & " " & strTen(Right(strB, 1))
End If
End Function
Public Function Convision(strA As String) As String
Dim strRe As String
strRe = ""
strA = Format(strA, "###########0.00")
If StrComp(Right(strA, 2), "00") <> 0 Then strRe = " AND CENTS " & strTh(Right(strA, 2))
strA = Left(strA, Len(Trim(strA)) - 3)
If Len(strA) >= 2 Then
strRe = strTh(Right(strA, 2)) & strRe
strA = Left(strA, Len(Trim(strA)) - 2)
Else
strRe = strTh(Right(strA, 1)) & strRe
strA = ""
End If
If Len(strA) <= 0 Then
Convision = strRe
Exit Function
End If
strRe = strTh(Right(strA, 1)) & " HUNDRED " & strRe
strA = Left(strA, Len(Trim(strA)) - 1)
If Len(strA) <= 0 Then
Convision = strRe
Exit Function
End If
strRe = " THOUSAND " & strRe
If Len(strA) >= 2 Then
strRe = strTh(Right(strA, 2)) & strRe
strA = Left(strA, Len(Trim(strA)) - 2)
Else
strRe = strTh(Right(strA, 1)) & strRe
strA = ""
End If
If Len(strA) <= 0 Then
Convision = strRe
Exit Function
End If
strRe = " HUNDRED " & strRe
strRe = strTh(Right(strA, 1)) & strRe
strA = Left(strA, Len(strA) - 1)
If Len(strA) <= 0 Then
Convision = strRe
Exit Function
End If
strRe = " THOUSAND " & strRe
If Len(strA) >= 2 Then
strRe = strTh(Right(strA, 2)) & strRe
strA = Left(strA, Len(Trim(strA)) - 2)
Else
strRe = strTh(Right(strA, 1)) & strRe
strA = Left(strA, Len(Trim(strA)) - 1)
End If
If Len(strA) <= 0 Then
Convision = strRe
Exit Function
ElseIf Len(strA) <= 2 Then
Convision = strTh(strA) & " HUNDRED " & strRe
Exit Function
Else
MsgBox "数据超出范围", vbOKOnly, "information"
End If
End Function
[em26]
作者: zhuyiwen 时间: 2002-8-3 19:27
我的想法是整数按节处理,小数部份单个处理。有谁试试?
不过这种函数对我来说,一般用不上,所以不想深研。[em26]
作者: zhuyiwen 时间: 2002-8-3 19:47
你可以找原作者:欧阳峰[QQ:48121454]
原贴链接
http://bbs.tencent.com/cgi-bin/b ... 7/&st=0&sc=
[此贴子已经被zhuyiwen于2002-8-3 11:47:16编辑过]
作者: HG 时间: 2002-8-3 21:10
我的已上傳,誰有興趣可以看源碼?(bug還末全消除)
ftp://access-cn@office-cn.net/hg.mdb
歡迎大家多參於.裡迥好東東很多.
作者: secowu 时间: 2005-8-17 16:49
怎么没人搞呢?
作者: abcder7086 时间: 2006-1-17 06:51
求支票数字日期转中文大写日期源码?
欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) |
Powered by Discuz! X3.3 |