想与大伙共享---将数字转为汉字或汉字货币大写

mvb2211 2002-08-02 11:08:36
加精
向Bardo 致敬!

...全文
491 16 打赏 收藏 转发到动态 举报
写回复
用AI写文章
16 条回复
切换为时间正序
请发表友善的回复…
发表回复
xiaoxinghappy 2002-08-02
  • 打赏
  • 举报
回复
这是我写的,好久以前的事,我想不会烂到哪里去的。

'[参数]
'TrueVal:要转换的数据
'[返回值]
'返回大写的数字字串

Public Function DigitalCashToChinese(TrueVal As Currency) As String
Dim tmpVal As Integer, sVal As Currency
Dim ZeroFlag As Boolean, ZeroOnce As Boolean
Dim I As Integer, j As Integer
Dim T_S1 As String
Dim T_S2 As String
Dim T_str As String
Dim CNumber1() As String
Dim CNumber2() As String

On Error GoTo Cov_Err
DigitalCashToChinese = ""

sVal = TrueVal

TrueVal = Abs(TrueVal)

If TrueVal > 9999999999# Then
DigitalCashToChinese = "金额太大!"
Exit Function
ElseIf TrueVal = 0 Or TrueVal < 0.005 Then
DigitalCashToChinese = "零元整"
Exit Function
End If
CNumber1 = Array("零","壹","贰","叁","肆","伍","陆","柒","捌","玖")
CNumber2 = Array("","拾","佰","仟","万","亿")

TrueVal = Abs(TrueVal)

TrueVal = Format(TrueVal, "0.00") * 100

T_S1 = Right(CStr(TrueVal), 2)

If TrueVal >= 100 Then

T_S2 = CStr(TrueVal)

TrueVal = Left(T_S2, Len(T_S2) - 2)

T_S2 = ""
T_str = ""
ZeroFlag = False
ZeroOnce = False
I = 0
j = 0
Do While TrueVal > 0
tmpVal = TrueVal Mod 10
TrueVal = Int(TrueVal / 10)
If tmpVal = 0 And T_str <> "" And ZeroOnce Then
ZeroFlag = True
ElseIf tmpVal <> 0 Then
ZeroOnce = True
If ZeroFlag = True Then
ZeroFlag = False
If Left(T_str, 1) <> CNumber1(0) Then T_str = CNumber1(0) & T_str
End If

T_str = CNumber1(tmpVal) & IIf(I = 0, "", CNumber2(I)) & CNumber2(0) & T_str
If CNumber2(0) <> "" Then
CNumber2(0) = ""
End If
End If
I = (I + 1) Mod 4
If I = 0 Then

If Not ZeroOnce And T_str <> "" Then
If Left(T_str, 1) <> CNumber1(0) Then T_str = CNumber1(0) & T_str
End If
ZeroOnce = False
CNumber2(0) = CNumber2(j + 4)
j = (j + 1) Mod 2
End If
Loop
T_str = T_str & "元"
End If

TrueVal = Val(T_S1)
If TrueVal > 0 Then
If TrueVal >= 10 Or T_str <> "" Then T_str = T_str & CNumber1(Int(TrueVal / 10)) & "

角"
If (TrueVal Mod 10) > 0 Then
T_str = T_str & CNumber1(Int(TrueVal Mod 10)) & "分"
Else
T_str = T_str & "整"
End If
Else
T_str = T_str & "整"
End If
DigitalCashToChinese = IIf(sVal < 0, "负" & T_str, T_str)
Exit Function

Cov_Err:
If Err.Number = 6 Then
DigitalCashToChinese = "金额太大或太小!"
Else
DigitalCashToChinese = "非法金额!"
End If
End Function

xiaoxinghappy 2002-08-02
  • 打赏
  • 举报
回复
'[参数]
'TrueVal:要转换的数据
'[返回值]
'返回大写的数字字串

Public Function DigitalCashToChinese(TrueVal As Currency) As String
Dim tmpVal As Integer, sVal As Currency
Dim ZeroFlag As Boolean, ZeroOnce As Boolean
Dim I As Integer, j As Integer
Dim T_S1 As String
Dim T_S2 As String
Dim T_str As String
Dim CNumber1(10) As String
Dim CNumber2(6) As String

On Error GoTo Cov_Err
DigitalCashToChinese = ""

sVal = TrueVal

TrueVal = Abs(TrueVal)

If TrueVal > 9999999999# Then
DigitalCashToChinese = "金额太大!"
Exit Function
ElseIf TrueVal = 0 Or TrueVal < 0.005 Then
DigitalCashToChinese = "零元整"
Exit Function
End If

CNumber1(0) = "零": CNumber1(1) = "壹": CNumber1(2) = "贰": CNumber1(3) = "叁": CNumber1(4) = "肆"
CNumber1(5) = "伍": CNumber1(6) = "陆": CNumber1(7) = "柒": CNumber1(8) = "捌": CNumber1(9) = "玖"
CNumber2(0) = "": CNumber2(1) = "拾": CNumber2(2) = "佰": CNumber2(3) = "仟"
CNumber2(4) = "万": CNumber2(5) = "亿"
': CNumber2(2) = "元": CNumber2(3) = "佰": CNumber2(4) = "仟"

TrueVal = Abs(TrueVal)

TrueVal = Format(TrueVal, "0.00") * 100

T_S1 = Right(CStr(TrueVal), 2)

If TrueVal >= 100 Then

T_S2 = CStr(TrueVal)

TrueVal = Left(T_S2, Len(T_S2) - 2)

T_S2 = ""
T_str = ""
ZeroFlag = False
ZeroOnce = False
I = 0
j = 0
Do While TrueVal > 0
tmpVal = TrueVal Mod 10
TrueVal = Int(TrueVal / 10)
If tmpVal = 0 And T_str <> "" And ZeroOnce Then
ZeroFlag = True
ElseIf tmpVal <> 0 Then
ZeroOnce = True
If ZeroFlag = True Then
ZeroFlag = False
If Left(T_str, 1) <> CNumber1(0) Then T_str = CNumber1(0) & T_str
End If

T_str = CNumber1(tmpVal) & IIf(I = 0, "", CNumber2(I)) & CNumber2(0) & T_str
If CNumber2(0) <> "" Then
CNumber2(0) = ""
End If
End If
I = (I + 1) Mod 4
If I = 0 Then

If Not ZeroOnce And T_str <> "" Then
If Left(T_str, 1) <> CNumber1(0) Then T_str = CNumber1(0) & T_str
End If
ZeroOnce = False
CNumber2(0) = CNumber2(j + 4)
j = (j + 1) Mod 2
End If
Loop
T_str = T_str & "元"
End If

TrueVal = Val(T_S1)
If TrueVal > 0 Then
If TrueVal >= 10 Or T_str <> "" Then T_str = T_str & CNumber1(Int(TrueVal / 10)) & "角"
If (TrueVal Mod 10) > 0 Then
T_str = T_str & CNumber1(Int(TrueVal Mod 10)) & "分"
Else
T_str = T_str & "整"
End If
Else
T_str = T_str & "整"
End If
DigitalCashToChinese = IIf(sVal < 0, "负" & T_str, T_str)
Exit Function

Cov_Err:
If Err.Number = 6 Then
DigitalCashToChinese = "金额太大或太小!"
Else
DigitalCashToChinese = "非法金额!"
End If
End Function

cnnrst 2002-08-02
  • 打赏
  • 举报
回复
收藏!
mvb2211 2002-08-02
  • 打赏
  • 举报
回复
再送一个最新版给大家,可以发现,如果没有小数点以及将数字与货币区分开来,则只
要几行代码即可!

Function GetChinaNum(OrgNum As Double, Optional IsMoney As Integer, _
Optional dotNum As Integer) As String
'参数OrgNum: 为数字
'参数IsMoney: 为是不是返回人民币大写(1返回)
'参数dotNum: 为设置小数点后面的位数,默认为0,最大为8位
Dim NumDigit(1) As String, NumChar(1) As String
Dim AfterDotNum As String, NewNum As Double, StrNum As String
Dim RepPostNum As Variant, i As Integer, RepNum(1)
Dim MoenyNum As Variant, DotSite As Integer
NumDigit(0) = "0千0百0十0亿0千0百0十0万0千0百0十0"
NumDigit(1) = "0仟0佰0拾0亿0仟0佰0拾0万0仟0佰0拾0元0角0分"
NumChar(0) = "零一二三四五六七八九十"
NumChar(1) = "零壹贰叁肆伍陆柒捌玖拾"
RepNum(0) = Array("零十", "零百", "零千", &quo
t;零零", "零零")
RepNum(1) = Array("零拾", "零佰", "零仟", &quo
t;零角", "零零", "零零")
RepPostNum = Array("零万", "零亿", "零元")

If dotNum > 8 Then dotNum = 8
OrgNum = FormatNumber(OrgNum, dotNum, , , vbFalse)
If IsMoney Then
NewNum = Replace(Format(OrgNum, "############.00"), ".&quo
t;, "")
Else
NewNum = Int(OrgNum)
End If
StrNum = Format(NewNum, Right(NumDigit(IsMoney), _
2 * Len(Trim(NewNum)) - 1 + IsMoney))
For i = 0 To 10
StrNum = Replace(StrNum, i, Mid(NumChar(IsMoney), i + 1, 1))
Next i
For i = 0 To UBound(RepNum(IsMoney))
StrNum = Replace(StrNum, RepNum(IsMoney)(i), _
Left(RepNum(IsMoney)(i), 1))
Next i
For i = 0 To 1 + IsMoney
StrNum = Replace(StrNum, _
RepPostNum(i), Right(RepPostNum(i), 1))
Next i
If OrgNum < 20 * (1 + IsMoney * 99) Then
If IsMoney Then
StrNum = Replace(StrNum, "壹拾", "拾")
Else
StrNum = Replace(StrNum, "一十", "十")
End If
End If
If dotNum <> 0 Then
DotSite = InStr(1, OrgNum, ".")
If DotSite > 0 And _
DotSite + IsMoney * 2 + 1 <= Len(OrgNum) Then
AfterDotNum = Mid(OrgNum, _
DotSite + IsMoney * 2 + 1, dotNum)
For i = 0 To 10
AfterDotNum = Replace(AfterDotNum, i, _
Mid(NumChar(IsMoney), i + 1, 1))
Next i
End If
End If
If IsMoney Then
GetChinaNum = StrNum & AfterDotNum & "整"
If dotNum <= 2 Then
GetChinaNum = Replace(GetChinaNum, "零分", "")
End If
Else
GetChinaNum = StrNum & "点" & AfterDotNum
If OrgNum > 0 Then
GetChinaNum = Replace(GetChinaNum, "零点", "点")
End If
End If

Erase NumDigit
Erase NumChar
Erase RepNum

End Function


签名档:这是我们的家,但愿大家喜欢

Bardo 回复于:7月5日 18:29 删除 隐藏IP

--------------------------------------------------------------------------------
这里是今日改写的用位运算的方法实现的代码,这一代码不易懂,但是代码行数要双前
一版本还要少20多行:

Public Function GetChineseNum(ByVal OrgNum As Double, _
Optional ByVal IsMoney As Integer, _
Optional ByVal dotNum As Integer) As String
'参数OrgNum: 为数字
'参数IsMoney: 为是不是返回人民币大写(1返回)
'参数dotNum: 为设置小数点后面的位数,默认为0,最大为8位
Dim NumSite(1), NumChar(1), NewNumStr As String, DotSite As Integer
Dim i As Integer, iDs As Boolean, iNs As Boolean, iLn As Boolean
Dim AfterDotNum As String
NumSite(0) = Array("", "", "十", "百"
;, "千", "万", "十", "百", "千&
quot;, "亿", "十", "百", "千")
NumSite(1) = Array("", "", "拾", "佰"
;, "仟", "万", "拾", "佰", "仟&
quot;, "亿", "拾", "佰", "仟")
NumChar(0) = Array("", "零", "一", "二&qu
ot;, "三", "四", "五", "六", "七
", "八", "九", "十")
NumChar(1) = Array("", "零", "壹", "贰&qu
ot;, "叁", "肆", "伍", "陆", "柒
", "捌", "玖", "拾")
NewNumStr = StrReverse(Int(OrgNum))
For i = 1 To Len(NewNumStr)
iDs = Abs((i Mod 4) <> 1) '此用于"万,亿"的设置
iNs = Abs((Mid(NewNumStr, i, 1) <> 0)) '本位数据是否为0
iLn = IIf(iNs <> 0, 0, iLn) '如果后一位是0,则本位不再有"零
"
GetChineseNum = NumChar(IsMoney)((Mid(NewNumStr, i, 1) + 1) * Abs((iNs O
r iDs) And (iLn = 0))) & _
NumSite(IsMoney)(i * Abs(iNs Or (iDs = 0))) & GetChineseNum
iLn = Abs(Not iNs) '保存本次的是否为0
Next i
If OrgNum < 20 Then '小于20我们通常不说"一十几"而说"十几
"
If IsMoney Then
GetChineseNum = Replace(GetChineseNum, "壹拾", "拾&qu
ot;)
Else
GetChineseNum = Replace(GetChineseNum, "一十", "十&qu
ot;)
End If
End If

If dotNum <> 0 Then '处理小数
DotSite = InStr(1, OrgNum, ".")
If DotSite > 0 Then
AfterDotNum = Mid(OrgNum, DotSite, dotNum)
If IsMoney Then
AfterDotNum = Format(AfterDotNum, "元0角0分" & Str
ing(dotNum - 2, "0") & "整")
AfterDotNum = Replace(AfterDotNum, "0角", ""
)
Else
AfterDotNum = "点" & AfterDotNum
End If
For i = 0 To 10
AfterDotNum = Replace(AfterDotNum, i, NumChar(IsMoney)(i + 1))
Next i
End If
End If
GetChineseNum = GetChineseNum & AfterDotNum
Erase NumSite '删除数组
Erase NumChar

End Function


签名档:这是我们的家,但愿大家喜欢

Bardo 回复于:7月15日 12:13 删除 隐藏IP

--------------------------------------------------------------------------------
现在再给大家一个来自港台程序员所写的源程序。但是,可惜不知作者是谁。这个程序
自然没有上面两 个版本功能全。但程序同样也是编得相当不错的!

Private Function CChinese(StrEng As String) As String
If Not IsNumeric(StrEng) Or StrEng Like "*.*" Or StrEng Lik
e "*-*" Then
If Trim(StrEng) <> "" Then MsgBox "无效的数
字"
CChinese = "": Exit Function
End If
Dim intLen As Integer, intCounter As Integer
Dim strCh As String, strTempCh As String
Dim strSeqCh1 As String, strSeqCh2 As String
Dim strEng2Ch As String
strEng2Ch = "零壹贰叁肆伍陆柒捌玖"
strSeqCh1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strSeqCh2 = " 万亿兆"
StrEng = CStr(CDec(StrEng))
intLen = Len(StrEng)
For intCounter = 1 To intLen
strTempCh = Mid(strEng2Ch, Val(Mid(StrEng, intCounter, 1)) + 1,
1)
If strTempCh = "零" And intLen <> 1 Then
If Mid(StrEng, intCounter + 1, 1) = "0" Or (intLe
n - intCounter + 1) Mod 4 = 1 Then
strTempCh = ""
End If
Else
strTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - in
tCounter + 1, 1))
End If
If (intLen - intCounter + 1) Mod 4 = 1 Then
strTempCh = strTempCh & Mid(strSeqCh2, (intLen - intCou
nter + 1) \ 4 + 1, 1)
If intCounter > 3 Then
If Mid(StrEng, intCounter - 3, 4) = "0000" T
hen strTempCh = Left(strTempCh, Len(strTempCh) - 1)
End If
End If
strCh = strCh & Trim(strTempCh)
Next
CChinese = strCh
End Function

签名档:这是我们的家,但愿大家喜欢
mvb2211 2002-08-02
  • 打赏
  • 举报
回复
也许人人都能写这种函数,但是要是以最少的代码完成,好象并不好做,以下是代码:

Function GetChinaNum(OrgNum As Double, Optional IsMoney As Integer, Optional
dotNum As Integer) As String
'参数一为数字
'参数二为是不是返回人民币大写(1返回)
'参数三为设置小数点后面的位数,默认为0

On Error Resume Next
Dim numwei(1) As String, numshu(1) As String
Dim i As Integer, num As String, RepNum(1)
Dim AfterDotNum As String
numwei(0) = "0千0百0十0亿0千0百0十0万0千0百0十0"
numshu(0) = "零一二三四五六七八九十"
numwei(1) = "0仟0佰0拾0亿0仟0佰0拾0万0仟0佰0拾0"
numshu(1) = "零壹贰叁肆伍陆柒捌玖拾"
RepNum(0) = Array("零万", "零十万", "零百万&quo
t;, "零亿", "零十亿", "零百亿")
RepNum(0) = Array("零十", "零百", "零千",
"零零", "零零")
RepNum(1) = Array("零万", "零拾万", "零佰万&quo
t;, "零亿", "零拾亿", "零佰亿")
RepNum(1) = Array("零拾", "零佰", "零仟",
"零零", "零零")
'9 8765 4321
num = Format(OrgNum, Right("0千0百0十0亿0千0百0十0万0千0百0十0"
;, _
2 * Len(Trim(OrgNum)) - 1))
For i = 0 To 10
num = Replace(num, i, Mid(numshu(IsMoney), i + 1, 1))
Next i
For i = 0 To 5
num = Replace(num, RepNum(IsMoney)(i), Right(RepNum(IsMoney)(i), 1))
Next i
For i = 0 To 4
num = Replace(num, RepNum(IsMoney)(i), Left(RepNum(IsMoney)(i), 1))
Next i
If dotNum <> 0 Then
AfterDotNum = Mid(FormatNumber(OrgNum, dotNum, , , vbFalse), _
InStr(OrgNum, ".") + 1, dotNum)
For i = 0 To 10
AfterDotNum = Replace(AfterDotNum, i, Mid(numshu(IsMoney), i + 1
, 1))
Next i
GetChinaNum = num & "点" & AfterDotNum
Else
GetChinaNum = num
End If

End Function


签名档:这是我们的家,但愿大家喜欢

Bardo 回复于:7月3日 13:52 删除 隐藏IP

--------------------------------------------------------------------------------
Function GetChinaNum(OrgNum As Double, Optional IsMoney As Integer, Optional
dotNum As Integer) As String
'参数一为数字
'参数二为是不是返回人民币大写(1返回)
'参数三为设置小数点后面的位数,默认为0
Dim numwei(1) As String, numshu(1) As String
Dim i As Integer, num As String, RepNum(1)
Dim AfterDotNum As String
numwei(0) = "0千0百0十0亿0千0百0十0万0千0百0十0"
numshu(0) = "零一二三四五六七八九十"
numwei(1) = "0仟0佰0拾0亿0仟0佰0拾0万0仟0佰0拾0"
numshu(1) = "零壹贰叁肆伍陆柒捌玖拾"
RepNum(0) = Array("零万", "零十万", "零百万",
"零亿", "零十亿", "零百亿")
RepNum(0) = Array("零十", "零百", "零千", &quo
t;零零", "零零")
RepNum(1) = Array("零万", "零拾万", "零佰万",
"零亿", "零拾亿", "零佰亿")
RepNum(1) = Array("零拾", "零佰", "零仟", &quo
t;零零", "零零")
'9 8765 4321
num = Format(OrgNum, Right(numwei(IsMoney), 2 * Len(Trim(OrgNum)) - 1))
For i = 0 To 10
num = Replace(num, i, Mid(numshu(IsMoney), i + 1, 1))
Next i
For i = 0 To 5
num = Replace(num, RepNum(IsMoney)(i), Right(RepNum(IsMoney)(i), 1))
Next i
For i = 0 To 4
num = Replace(num, RepNum(IsMoney)(i), Left(RepNum(IsMoney)(i), 1))
Next i
If dotNum <> 0 Then
AfterDotNum = Mid(FormatNumber(OrgNum, dotNum, , , vbFalse), _
InStr(OrgNum, ".") + 1, dotNum)
For i = 0 To 10
AfterDotNum = Replace(AfterDotNum, i, Mid(numshu(IsMoney), i + 1, 1))
Next i
GetChinaNum = num & "点" & AfterDotNum
Else
GetChinaNum = num
End If

End Function


签名档:这是我们的家,但愿大家喜欢

Bardo 回复于:7月3日 17:37 删除 隐藏IP

--------------------------------------------------------------------------------
以下是最新版的程序:

Function GetChinaNum(OrgNum As Double, Optional IsMoney As Integer, _
Optional dotNum As Integer) As String
'参数OrgNum: 为数字
'参数IsMoney: 为是不是返回人民币大写(1返回)
'参数dotNum: 为设置小数点后面的位数,默认为0,最大为8位
Dim NumDigit(1) As String, NumChar(1) As String
Dim AfterDotNum As String, NewNum As Double, StrNum As String
Dim RepPostNum As Variant, i As Integer, RepNum(1)

NumDigit(0) = "0千0百0十0亿0千0百0十0万0千0百0十0"
NumDigit(1) = "0仟0佰0拾0亿0仟0佰0拾0万0仟0佰0拾0"
NumChar(0) = "零一二三四五六七八九十"
NumChar(1) = "零壹贰叁肆伍陆柒捌玖拾"
RepNum(0) = Array("零十", "零百", "零千", &quo
t;零零", "零零")
RepNum(1) = Array("零拾", "零佰", "零仟", &quo
t;零零", "零零")
RepPostNum = Array("零万", "零亿")

If dotNum <> 0 Then
If OrgNum >= 1 Then
NewNum = Left(Trim(OrgNum), InStr(Trim(OrgNum), ".") - 1)
End If
Else
NewNum = Int(OrgNum)
End If
StrNum = Format(NewNum, Right(NumDigit(IsMoney), _
2 * Len(Trim(NewNum)) - 1))
For i = 0 To 10
StrNum = Replace(StrNum, i, Mid(NumChar(IsMoney), i + 1, 1))
Next i
For i = 0 To 4
StrNum = Replace(StrNum, RepNum(IsMoney)(i), _
Left(RepNum(IsMoney)(i), 1))
Next i
If OrgNum < 20 Then
If IsMoney Then
StrNum = Replace(StrNum, "壹拾", "拾")
Else
StrNum = Replace(StrNum, "一十", "十")
End If
End If
If dotNum <> 0 Then
If dotNum > 8 Then dotNum = 8
OrgNum = FormatNumber(OrgNum, dotNum, , , vbFalse)
AfterDotNum = Mid(OrgNum, InStr(OrgNum, ".") + 1, dotNum)
If IsMoney Then
AfterDotNum = Format(AfterDotNum, _
Left("0角0分000000", dotNum + 2))
End If
For i = 0 To 10
AfterDotNum = Replace(AfterDotNum, i, _
Mid(NumChar(IsMoney), i + 1, 1))
Next i
End If
If IsMoney Then
GetChinaNum = StrNum & "元" & AfterDotNum & "
;整"
Else
GetChinaNum = StrNum & "点" & AfterDotNum
End If
For i = 0 To 1
GetChinaNum = Replace(GetChinaNum, _
RepPostNum(i), Right(RepPostNum(i), 1))
Next i
If IsMoney = 0 Then
If OrgNum > 0 Then
GetChinaNum = Replace(GetChinaNum, "零点", "点")
End If
Else
If OrgNum < 1 Then
GetChinaNum = Replace(GetChinaNum, "零元", "")
Else
GetChinaNum = Replace(GetChinaNum, "零元", "元")
End If
GetChinaNum = Replace(GetChinaNum, "零角", "零")
If dotNum <= 2 Then
GetChinaNum = Replace(GetChinaNum, "零分", "")
End If
End If

Erase NumDigit
Erase NumChar
Erase RepNum
End Function


签名档:这是我们的家,但愿大家喜欢

Bardo 回复于:7月3日 18:26 删除 隐藏IP
mvb2211 2002-08-02
  • 打赏
  • 举报
回复
呵呵,向高手们致敬!
zjmdboy 2002-08-02
  • 打赏
  • 举报
回复
收藏
wzsswz 2002-08-02
  • 打赏
  • 举报
回复

Public Function MoneyToUpper(pass_money As Currency) As String
Dim i, j, k, m, n, curr_num As Integer
Dim numstr, bitstr, monstr, tempstr, currstr As String

numstr = "仟佰拾万仟佰拾圆角分"
bitstr = "零壹贰叁肆伍陆柒捌玖"
MoneyToUpper = ""
monstr = Format(pass_money, "0.00")
m = Len(monstr)
If (m <> 0) And (pass_money <> 0) Then
n = 11
i = n - m + 1
tempstr = ""
j = 0
k = 1
While (i <= n)
currstr = Mid(monstr, k, 1)
If (currstr = "") Or (currstr = ".") Then GoTo nextbit
curr_num = CInt(Mid(monstr, k, 1))
If (curr_num <> 0) Then

If (i < 9) Then
tempstr = tempstr + Mid(bitstr, curr_num * 1 + 1, 1) + Mid(numstr, (i - 1) * 1 + 1, 1)
Else
tempstr = tempstr + Mid(bitstr, curr_num * 1 + 1, 1) + Mid(numstr, (i - 1) * 1, 1)
j = 0
End If
Else
If i < 4 And j = 0 And InStr(monstr, ".") - 1 >= 6 Then
If CInt(Mid(monstr, i + 1, 4 - i)) = 0 Then tempstr = tempstr + Mid(numstr, 4, 1)
End If
If (j = 0) Then
tempstr = tempstr + Mid(bitstr, curr_num * 1 + 1, 1)
j = j + 1
End If
End If

nextbit:
If (j <> 0) And (currstr = ".") Then
tempstr = Mid(tempstr, 1, Len(tempstr) - 1) + "圆"
j = 0
End If
i = i + 1
k = k + 1
Wend
If (j <> 0) Then
tempstr = Mid(tempstr, 1, Len(tempstr) - 1) + "整"
End If
MoneyToUpper = tempstr
End If
End Function


与楼上的代码比较,我的代码实现的功能最少,长度又受限制,需要多向楼上学习学习啊
pick2103 2002-08-02
  • 打赏
  • 举报
回复
厉害!厉害!小弟佩服!
playyuer 2002-08-02
  • 打赏
  • 举报
回复
可无任何长度限制
Option Explicit
Public Function NtoC(ByVal sNum As String, Optional BITs As String = ",拾,佰,仟", Optional UNITs As String = ",[万],[亿],[兆],[万兆]", Optional ByVal Yuan As String = "美圆", Optional ByVal Jiao As String = "美角", Optional ByVal Fen As String = "美分") As String
If Val(Trim(sNum)) > 0 Then
Dim sIntD, sDecD As String
Dim i, iCount, j, iLength As Integer
Dim lStartPos As Long
Dim sBIT() As String
Dim sUNIT() As String
Dim sCents(2) As String
sBIT = VBA.Split(BITs, ",")
sUNIT = VBA.Split(UNITs, ",")
sCents(0) = Fen
sCents(1) = Jiao
Dim temp As String
If InStr(Trim(sNum), ".") > 0 Then
temp = Left(Trim(sNum), InStr(Trim(sNum), ".") - 1)
Else
temp = Trim(sNum)
End If
iCount = IIf(Len(temp) Mod 4, Len(Trim(temp)) \ 4 + 1, Len(Trim(temp)) \ 4)
lStartPos = 1
For i = iCount To 1 Step -1
If i = iCount And Len(Trim(temp)) Mod 4 <> 0 Then
iLength = Len(Trim(temp)) Mod 4
Else
iLength = 4
End If
sIntD = Mid(Trim(temp), lStartPos, iLength)
For j = 1 To Len(Trim(sIntD))
If Val(Mid(sIntD, j, 1)) <> 0 Then
NtoC = NtoC & Choose(Val(Mid(sIntD, j, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖") & sBIT(Len(Trim(sIntD)) - j)
Else
If Val(Mid(sIntD, j + 1, 1)) <> 0 Then
NtoC = NtoC & "零"
End If
End If
Next j
lStartPos = lStartPos + iLength
If i < iCount Then
If (Val(Mid(sIntD, Len(Trim(sIntD)), 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 1, 1)) <> 0 Or Val(Mid(sIntD, Len(Trim(sIntD)) - 2, 1)) Or Val(Mid(sIntD, Len(Trim(sIntD)) - 3, 1)) <> 0) Then
If i < UBound(sUNIT) + 1 Then
NtoC = NtoC & sUNIT(i - 1)
'Else
' NtoC = NtoC & sUNIT(i - 1)
End If
End If
Else
'If i < UBound(sUNIT) + 1 Then
NtoC = NtoC & sUNIT(i - 1)
'End If
End If
Next
If Len(Trim(NtoC)) > 0 Then
NtoC = NtoC & Yuan
End If
'小数
If InStr(1, Trim(sNum), ".") <> 0 Then
sDecD = Right(sNum, Len(Trim(sNum)) - InStr(1, Trim(sNum), "."))
For i = 1 To Len(Trim(sDecD))
If Val(Mid(Trim(sDecD), i, 1)) <> 0 Then
NtoC = NtoC & Choose(Val(Mid(Trim(sDecD), i, 1)), "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
NtoC = NtoC & sCents(2 - i)
If i >= 2 Then
Exit For
End If
Else
If Len(Trim(NtoC)) > 0 Then
NtoC = NtoC & "零"
End If
End If
Next i
Else
NtoC = NtoC & "整"
End If
Else
NtoC = "零" & Yuan
End If
End Function

Private Sub Command1_Click()
VBA.MsgBox NtoC("111111111111111111.97")
End Sub
zyb_8022 2002-08-02
  • 打赏
  • 举报
回复
xuexi
willway 2002-08-02
  • 打赏
  • 举报
回复
有前辈的指引,晚生又长见识了,,,
besti_chs 2002-08-02
  • 打赏
  • 举报
回复
下面这两行语法有问题,是吗?

RepNum(0) = Array("零十", "零百", "零千", "零零", "零零")
RepNum(1) = Array("零拾", "零佰", "零仟", "零零", "零零")
handsomeduke 2002-08-02
  • 打赏
  • 举报
回复
哦,拿回去用用先!
pick2103 2002-08-02
  • 打赏
  • 举报
回复
研究研究,看看哪个货真价实

给分吗?哈哈
wzsswz 2002-08-02
  • 打赏
  • 举报
回复
高!

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧