| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 479 人关注过本帖
标题:初来,发一个函数!
只看楼主 加入收藏
满江红
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2006-2-16
收藏
 问题点数:0 回复次数:2 
初来,发一个函数!
'将小写金额转换成大写金额
Public Function ToChinMoney(pStrEng As String) As String
On Error GoTo Err
pStrEng = ToChinNum(CStr(Round(CDec(pStrEng), 2)))
Dim intLen As Integer
intLen = InStr(pStrEng, "点")
If intLen <= 0 Then
pStrEng = pStrEng & "元整"
Else
pStrEng = Replace(pStrEng, "点", "元")
pStrEng = Left(pStrEng, intLen + 1) & "角" & Right(pStrEng, Len(pStrEng) - intLen - 1)
If Right(pStrEng, 1) = "角" Then
pStrEng = pStrEng & "整"
Else
pStrEng = pStrEng & "分"
End If
End If
If pStrEng <> "零元整" Then
pStrEng = Replace(pStrEng, "零元", "")
End If
ToChinMoney = pStrEng
Exit Function
Err:
ToChinMoney = ""
End Function
2006-02-16 12:06
满江红
Rank: 1
等 级:新手上路
帖 子:3
专家分:0
注 册:2006-2-16
收藏
得分:0 
'将小写数字转换成大写数字:
Public Function ToChinNum(pStrEng As String) As String
On Error GoTo Err
If Not IsNumeric(pStrEng) Then
ToChinNum = ""
Exit Function
End If
Dim strEng2Ch As String, strSeqCh1 As String, strSeqCh2 As String
Dim strCh As String, strTempCh As String, strTempXs As String
Dim intLen As Integer, i As Integer
strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh2 = " 万亿兆"
pStrEng = CStr(CDec(pStrEng))
If Left(pStrEng, 1) = "-" Then '是负数
strCh = "负"
pStrEng = Right(pStrEng, Len(pStrEng) - 1)
End If
intLen = InStr(pStrEng, ".")
If intLen > 0 Then '有小数
strTempXs = Right(pStrEng, Len(pStrEng) - intLen)
pStrEng = Left(pStrEng, intLen - 1)
End If
intLen = Len(pStrEng)
For i = 1 To intLen
strTempCh = Mid(strEng2Ch, Val(Mid(pStrEng, i, 1)) + 1, 1)
If strTempCh = "零" And intLen <> 1 Then
If Mid(pStrEng, i + 1, 1) = "0" Or (intLen - i + 1) Mod 4 = 1 Then
strTempCh = ""
End If
Else
strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - i + 1, 1))
End If
If (intLen - i + 1) Mod 4 = 1 Then
strTempCh = strTempCh & Mid(strSeqCh2, (intLen - i + 1) \ 4 + 1, 1)
If i > 3 Then
If Mid(pStrEng, i - 3, 4) = "0000" Then strTempCh = Left(strTempCh, Len(strTempCh) - 1)
End If
End If
strCh = strCh & Trim(strTempCh)
Next
intLen = Len(strTempXs)
If intLen > 0 Then
If strCh = "" Or strCh = "负" Then
strCh = strCh & "零"
End If
strCh = strCh & "点"
For i = 1 To intLen
strCh = strCh & Mid(strEng2Ch, Val(Mid(strTempXs, i, 1)) + 1, 1)
Next
End If
ToChinNum = strCh
Exit Function
Err:
ToChinNum = ""
End Function
2006-02-16 12:07
wsn
Rank: 2
等 级:新手上路
威 望:5
帖 子:321
专家分:0
注 册:2006-2-9
收藏
得分:0 


我也来顶一下,SQL下用的函数,同样的功能
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS OFF
GO

create FUNCTION GETUC(@JEv decimal(10,2) )
returns @standuc table (UC varchar(100))
as
begin
declare @standardUC varchar(100)
declare @BZstr varchar(100)
declare @SJstr varchar(100)
declare @BJstr varchar(100)
declare @LSstr varchar(100)
declare @LenJe int
declare @lenZS int
declare @fJE varchar(100)
declare @Jc1 int
declare @Jc2 int
declare @i int
declare @LsJE int
set @BZstr = '壹贰叁肆伍陆柒捌玖'
set @SJstr = '万亿万亿万亿万亿万亿万亿万亿万亿'
set @BJstr = '拾佰仟'
set @fJE = round(@JEv ,2) --此处尚差格式化
set @LSstr = ''
set @LenJe = Len(@fJE)
set @LsJE =SUBSTRING(@fJE, @LenJe, 1)
If @LsJE = 0
set @LSstr = '零分'
Else
set @LSstr = SUBSTRING (@BZstr, @LsJE, 1) + '分'
set @LsJE = SUBSTRING (@fJE, @LenJe - 1, 1)
If @LsJE = '0'
set @LSstr = '零角' + @LSstr
else
set @LSstr = SUBSTRING (@BZstr, @LsJE, 1) + '角' + @LSstr
set @lenZS = 0
set @LSstr = '元' + @LSstr
set @i=@lenje-3
while @i>0
begin
set @lenZS = @lenZS + 1
set @Jc1 = cast((@lenZS % 4) as DECIMAL) --'取拾佰仟
set @jc2 = cast((@lenZS - 1) / 4 as DECIMAL) --'取万亿
If @Jc2 <> 0 And @Jc1 = 1
set @LSstr = SUBSTRING (@SJstr, @Jc2, 1)+ @LSstr
If @Jc1 = 0
set @LSstr = '仟' + @LSstr
Else If @Jc1 - 1 > 0
set @LSstr = SUBSTRING (@BJstr, @Jc1 - 1, 1) + @LSstr

set @LsJE = SUBSTRING (@fJE, @i, 1)
If @LsJE = 0
set @LSstr = '零' + @LSstr
Else
set @LSstr = SUBSTRING (@BZstr, @LsJE, 1) + '' + @LSstr
set @i=@i-1
end
If SUBSTRING (@LSstr, 1, 1) = '零'
set @LSstr = Right(@LSstr, Len(@LSstr) - 2)
set @standardUC = @LSstr

insert into @standuc(uc) select @standardUC
return
end


GO
SET QUOTED_IDENTIFIER OFF
GO
SET ANSI_NULLS ON
GO


已婚男人!没事请勿打扰·老婆格言:①不准對她耍酷 ②不准讓她吃醋 ③吵架我要讓步 ④揍我我要挺住⊙⊙
2006-02-16 14:02
快速回复:初来,发一个函数!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.011571 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved