山寨机中的战斗机！	程序优化工程师到底对IT界有没有贡献

求最简单算法

楼主dashanshi（大山）2001-12-19 13:01:30 在 VB / 基础类提问

将一串不带小数的数字转换成用大写钱币。如200102354，要读成贰亿零拾万贰千三百五十四元。不能读成贰亿零零拾万零贰千三百五十四元。问题点数：75、回复次数：20Top

1 楼afflatuswind（波波）回复于 2001-12-19 13:09:50 得分 0

Dim Num_To_Chinese(10) As String

Sub Init_Chinese()

Num_To_Chinese(0) = "零"
Num_To_Chinese(1) = "壹"
Num_To_Chinese(2) = "贰"
Num_To_Chinese(3) = "叁"
Num_To_Chinese(4) = "肆"
Num_To_Chinese(5) = "伍"
Num_To_Chinese(6) = "陆"
Num_To_Chinese(7) = "柒"
Num_To_Chinese(8) = "捌"
Num_To_Chinese(9) = "玖"

End Sub

Function Get_Chinese(ByVal m As Currency) As String

Dim Pre As integer
Dim Had_Frist_Num As Boolean
Dim temp As String

Init_Chinese

Pre = 0

re:
Select Case m
Case Is >= 10000000 And m < 100000000
Had_Frist_Num = True
temp = Num_To_Chinese(Int(m / 10000000)) & "千"
Pre = 1
m = m - Int(m / 10000000) * 10000000
GoTo re
Case Is >= 1000000 And m < 10000000
Had_Frist_Num = True
temp = temp & Num_To_Chinese(Int(m / 1000000)) & "百"
Pre = 2
m = m - Int(m / 1000000) * 1000000
GoTo re
Case Is >= 100000 And m < 1000000
If Not Had_Frist_Num Then
temp = Num_To_Chinese(Int(m / 100000)) & "拾"
ElseIf Pre <> 2 Then
temp = temp & "零" & Num_To_Chinese(Int(m / 100000)) & "拾"
Else
temp = temp & Num_To_Chinese(Int(m / 100000)) & "拾"
End If
Had_Frist_Num = True
Pre = 3
m = m - Int(m / 100000) * 100000
GoTo re
Case Is >= 10000 And m < 100000
If Not Had_Frist_Num Then
temp = Num_To_Chinese(Int(m / 10000)) & "万"
ElseIf Pre <> 3 Then
temp = temp & "零" & Num_To_Chinese(Int(m / 10000)) & "万"
Else
temp = temp & Num_To_Chinese(Int(m / 10000)) & "万"
End If
Had_Frist_Num = True
Pre = 4
m = m - Int(m / 10000) * 10000
GoTo re
Case Is >= 1000 And m < 10000
If Not Had_Frist_Num Then
temp = temp & Num_To_Chinese(Int(m / 1000)) & "千"
ElseIf Pre <> 4 Then
temp = temp & "万零" & Num_To_Chinese(Int(m / 1000)) & "千"
Else
temp = temp & Num_To_Chinese(Int(m / 1000)) & "千"
End If

Had_Frist_Num = True
Pre = 5
m = m - Int(m / 1000) * 1000
GoTo re

Case Is >= 100 And m < 1000
If Not Had_Frist_Num Then
temp = temp & Num_To_Chinese(Int(m / 100)) & "百"
ElseIf Pre <> 4 And Pre < 4 Then
temp = temp & "万零" & Num_To_Chinese(Int(m / 100)) & "百"
ElseIf Pre <> 5 Then
temp = temp & "零" & Num_To_Chinese(Int(m / 100)) & "百"
Else
temp = temp & Num_To_Chinese(Int(m / 100)) & "百"
End If
Had_Frist_Num = True
Pre = 6
m = m - Int(m / 100) * 100
GoTo re
Case Is >= 10 And m < 100
If Not Had_Frist_Num Then
temp = temp & Num_To_Chinese(Int(m / 10)) & "拾"
ElseIf Pre <> 4 And Pre < 4 Then
temp = temp & "万零" & Num_To_Chinese(Int(m / 10)) & "拾"
ElseIf Pre <> 6 Then
temp = temp & "零" & Num_To_Chinese(Int(m / 10)) & "拾 "
Else
temp = temp & Num_To_Chinese(Int(m / 10)) & "拾"
End If
Had_Frist_Num = True
Pre = 7
m = m - Int(m / 10) * 10
GoTo re
Case Is >= 1 And m < 10
If Not Had_Frist_Num Then
temp = temp & Num_To_Chinese(Int(m)) & "元"
ElseIf Pre <> 4 And Pre < 4 Then
temp = temp & "万零" & Num_To_Chinese(Int(m)) & "元"
ElseIf Pre <> 7 Then
temp = temp & "零" & Num_To_Chinese(Int(m)) & "元"
Else
temp = temp & Num_To_Chinese(Int(m)) & "元"
End If
Had_Frist_Num = True
Pre = 8
m = m - Int(m)
GoTo re
Case Is >= 0.1
If Not Had_Frist_Num Then
temp = temp & Num_To_Chinese(Int(m * 10)) & "角"
ElseIf Pre <> 4 And Pre < 4 Then
temp = temp & "万零" & Num_To_Chinese(Int(m * 10)) & "角"
ElseIf Pre <> 8 Then
temp = temp & "元零" & Num_To_Chinese(Int(m * 10)) & "角"
Else
temp = temp & Num_To_Chinese(Int(m * 10)) & "角"
End If
Pre = 9
m = m - Int(m * 10) / 10
GoTo re:
Case Is >= 0.01
If m <> 0 Then
If Not Had_Frist_Num Then
temp = temp & Num_To_Chinese(Int(m * 100)) & "分"
ElseIf Pre <> 4 And Pre < 4 Then
temp = temp & "万零" & Num_To_Chinese(Int(m * 100)) & "分"
ElseIf Pre <> 8 And Pre <> 9 Then
temp = temp & "元零" & Num_To_Chinese(Int(m * 100)) & "分"
Else
temp = temp & Num_To_Chinese(Int(m * 100)) & "分"
End If
End If
Pre = 10
End Select
temp = Trim(temp)
Get_Chinese = temp
End Function
调用格式：Get_Chinese( m as currency)
Top

2 楼afflatuswind（波波）回复于 2001-12-19 13:10:59 得分 0

最多到千万，很容易扩充的Top

3 楼dashanshi（大山）回复于 2001-12-19 13:15:13 得分 0

to afflatuswind:再想想,还能简单.你的代码太多了.Top

4 楼afflatuswind（波波）回复于 2001-12-19 13:19:34 得分 0

哇，兄弟你的钱还真多，千万都不够！！？！
赶制品，不够简练，多包涵！Top

5 楼dashanshi（大山）回复于 2001-12-19 13:35:43 得分 0

这里面有规律，你可以再考虑一下。Top

6 楼dashanshi（大山）回复于 2001-12-19 13:42:38 得分 0

这个问题应该可以在30行代码以内搞定，呵呵，可惜我也没有见到这个算法是怎样实现的，只好求教高手了。Top

7 楼dashanshi（大山）回复于 2001-12-19 13:48:54 得分 0

前提：两个文本控件，一个按钮。
在一个文本控件里输入数字串，单击按钮，另一个文本控件中出现大写货币数量。Top

8 楼sxmzmxh（哥舒帶菜刀）回复于 2001-12-19 14:07:50 得分 0

三十行好办，不断加“:“Top

9 楼lonaerd（redhat10）回复于 2001-12-19 14:18:59 得分 0

这个很简单，其实就是把"a,bcde,fghi"以四位拆分来读，例如先读a亿，然后读出bcde万，再读出fghi,最后把读出的字符相连就行了，算法够简单吧？Top

10 楼Random（随便）回复于 2001-12-19 14:29:47 得分 0

本人前不久做了一个函数，但多于30行
第二个参数为true则按照货币（即你的方式）转换，否则转换成小写汉字数字

Public Function NumToCH(ByVal varNum As Variant, _
Optional ByVal blnCurrency As Boolean) As String
Dim strRet, strInt, strDec, strNum, strTmp As String
Dim lngNum, lngNumPos, lngDotPos, lngLen, I As Long
Dim blnZero, blnPara As Boolean

On Error GoTo ErrProc

varNum = CDbl(varNum)
If varNum < 0 Then
strRet = "负"
varNum = -varNum
Else
strRet = ""
End If
If blnCurrency Then
varNum = Format(varNum, "0.00")
Else
varNum = Format(varNum, "0.############")
End If
lngDotPos = InStr(varNum, ".")
strInt = Left(varNum, lngDotPos - 1)
strDec = Right(varNum, Len(varNum) - lngDotPos)

strInt = Right(strInt, 12)
lngLen = Len(strInt)
For I = 1 To lngLen
lngNumPos = lngLen - I
strNum = Mid(strInt, I, 1)
If strNum = "0" Then
strNum = ""
blnZero = True
Else
GoSub TransNum
blnPara = False
If blnZero Then
strRet = strRet & "零"
blnZero = False
End If
Select Case lngNumPos
Case 0
strRet = strRet & strNum
Case 1, 5, 9
strRet = strRet & strNum & IIf(blnCurrency, "拾", "十")
Case 2, 6, 10
strRet = strRet & strNum & IIf(blnCurrency, "佰", "百")
Case 3, 7, 11
strRet = strRet & strNum & IIf(blnCurrency, "仟", "千")
End Select
End If
If lngNumPos = 8 Then
strRet = strRet & strNum & "亿"
If blnZero Then blnPara = True
ElseIf lngNumPos = 4 Then
If Not blnPara Then strRet = strRet & strNum & "万"
End If
Next I

If strInt = "0" Then strRet = strRet & "零"
blnZero = False

If blnCurrency Then
strRet = strRet & "圆"
If Len(strDec) > 0 Then
strNum = Mid(strDec, 1, 1)
GoSub TransNum
strRet = strRet & strNum & "角"
End If
If Len(strDec) > 1 Then
strNum = Mid(strDec, 2, 1)
GoSub TransNum
strRet = strRet & strNum & "分"
End If
'strRet = strRet & "整"
ElseIf strDec <> "" Then
strRet = strRet & "点"
For I = 1 To Len(strDec)
strNum = Mid(strDec, I, 1)
GoSub TransNum
strRet = strRet & strNum
Next
End If

NumToCH = strRet

Exit Function

TransNum:
Select Case strNum
Case "1"
strNum = IIf(blnCurrency, "壹", "一")
Case "2"
strNum = IIf(blnCurrency, "贰", "二")
Case "3"
strNum = IIf(blnCurrency, "叁", "三")
Case "4"
strNum = IIf(blnCurrency, "肆", "四")
Case "5"
strNum = IIf(blnCurrency, "伍", "五")
Case "6"
strNum = IIf(blnCurrency, "陆", "六")
Case "7"
strNum = IIf(blnCurrency, "柒", "七")
Case "8"
strNum = IIf(blnCurrency, "捌", "八")
Case "9"
strNum = IIf(blnCurrency, "玖", "九")
Case Else
strNum = "零"
End Select

Return

ErrProc:
NumToCH = CStr(varNum) & ",你他妈的找死啊！"
End Function

Top

11 楼Random（随便）回复于 2001-12-19 14:38:50 得分 0

本人早期曾采用过递归算法解决，代码如下，功能不如前者。前者可处理小数。
Public Function NumToChinese(ByVal varNum As Variant, _
Optional ByVal blnCurrency As Boolean) As String
Dim strNum, strTmp As String
Dim lngMOD, lngQUOT As Long

' *****************
'采用递归算法

strNum = ""
varNum = CLng(varNum)
Select Case varNum
Case Is >= 100000000 '一亿以上
lngQUOT = Int(varNum / 100000000)
strNum = NumToChinese(lngQUOT, blnCurrency) & "亿"
lngMOD = varNum Mod 100000000
If lngMOD > 0 Then
If lngMOD < 10000000 Or (lngQUOT Mod 10) = 0 Then strNum = strNum & "零"
strTmp = NumToChinese(lngMOD, blnCurrency)
If Left(strTmp, 1) = IIf(blnCurrency, "拾", "十") Then _
strTmp = IIf(blnCurrency, "壹", "一") & strTmp
strNum = strNum & strTmp
End If
Case Is >= 10000
lngQUOT = Int(varNum / 10000)
strNum = NumToChinese(lngQUOT, blnCurrency) & "万"
lngMOD = varNum Mod 10000
If lngMOD > 0 Then
If lngMOD < 1000 Or (lngQUOT Mod 10) = 0 Then strNum = strNum & "零"
strTmp = NumToChinese(lngMOD, blnCurrency)
If Left(strTmp, 1) = IIf(blnCurrency, "拾", "十") Then _
strTmp = IIf(blnCurrency, "壹", "一") & strTmp
strNum = strNum & strTmp
End If
Case Is >= 1000
lngQUOT = Int(varNum / 1000)
GoSub TransNum
strNum = strNum & IIf(blnCurrency, "仟", "千")
lngMOD = varNum Mod 1000
If lngMOD > 0 Then
If lngMOD < 100 Then strNum = strNum & "零"
strTmp = NumToChinese(lngMOD, blnCurrency)
If Left(strTmp, 1) = IIf(blnCurrency, "拾", "十") Then _
strTmp = IIf(blnCurrency, "壹", "一") & strTmp
strNum = strNum & strTmp
End If
Case Is >= 100
lngQUOT = Int(varNum / 100)
GoSub TransNum
strNum = strNum & IIf(blnCurrency, "佰", "百")
lngMOD = varNum Mod 100
If lngMOD > 0 Then
If lngMOD < 10 Then strNum = strNum & "零"
strTmp = NumToChinese(lngMOD, blnCurrency)
If Left(strTmp, 1) = IIf(blnCurrency, "拾", "十") Then _
strTmp = IIf(blnCurrency, "壹", "一") & strTmp
strNum = strNum & strTmp
End If
Case Is >= 10
lngQUOT = Int(varNum / 10)
If lngQUOT = 1 Then
strNum = IIf(blnCurrency, "拾", "十")
Else
GoSub TransNum
strNum = strNum & IIf(blnCurrency, "拾", "十")
End If
lngMOD = varNum Mod 10
If lngMOD > 0 Then strNum = strNum & NumToChinese(lngMOD, blnCurrency)
Case Else
lngQUOT = varNum
GoSub TransNum
End Select

NumToChinese = strNum
Exit Function

TransNum:
Select Case lngQUOT
Case 1
strNum = IIf(blnCurrency, "壹", "一")
Case 2
strNum = IIf(blnCurrency, "贰", "二")
Case 3
strNum = IIf(blnCurrency, "叁", "三")
Case 4
strNum = IIf(blnCurrency, "肆", "四")
Case 5
strNum = IIf(blnCurrency, "伍", "五")
Case 6
strNum = IIf(blnCurrency, "陆", "六")
Case 7
strNum = IIf(blnCurrency, "柒", "七")
Case 8
strNum = IIf(blnCurrency, "捌", "八")
Case 9
strNum = IIf(blnCurrency, "玖", "九")
Case Else
strNum = IIf(blnCurrency, "零", "零")
End Select
Return
End Function
Top

12 楼fraser01（王晓栋）回复于 2001-12-19 14:46:48 得分 0

我的代码够短了吧，不过没有经过详细测试。
Private Sub Command1_Click()
ReplaceChinese
End Sub

Private Sub ReplaceChinese()
Dim intValue As Integer
Dim arrChinese(0 To 9) As String
Dim strSta As String
arrChinese(0) = "零"
arrChinese(1) = "一"
arrChinese(2) = "二"
arrChinese(3) = "三"
arrChinese(4) = "四"
arrChinese(5) = "五"
arrChinese(6) = "六"
arrChinese(7) = "七"
arrChinese(8) = "八"
arrChinese(9) = "九"
strSta = "元拾百千万拾百千亿"
Text2 = ""
For i = 0 To 9
Text1 = Replace(Text1, CStr(i), arrChinese(i))
Next
For i = 1 To Len(Text1)
Text2 = IFZTN(Mid(Text1, Len(Text1) + 1 - i, 1) & Mid(strSta, i, 1)) & Text2
Text2 = Replace(Text2, "零零", "零")
Next
End Sub

Private Function IFZTN(strValue As String) As String
If InStr(strValue, "零") Then
IFZTN = "零"
Else
IFZTN = strValue
End If
End Function
Top

13 楼fraser01（王晓栋）回复于 2001-12-19 14:55:40 得分 0

前面的代码有点问题，我零时加了两行，在一个判断函数中：

Private Function IFZTN(strValue As String) As String
If InStr(strValue, "零") Then
IFZTN = "零"
If InStr(strValue, "元") Then IFZTN = "元"
If InStr(strValue, "万") Then IFZTN = "万"
Else
IFZTN = strValue
End If
End Function
Top

14 楼fraser01（王晓栋）回复于 2001-12-19 15:09:28 得分 0

我的代码还有点问题，不过最多加2到3行就能解决问题了。大家一齐想想吧。Top

15 楼foxruo（lily）回复于 2001-12-19 15:49:31 得分 0

u pTop

16 楼fraser01（王晓栋）回复于 2001-12-19 16:04:20 得分 0

怎么一下就没反应了？
Top

17 楼wufang（蓝点）回复于 2001-12-19 16:12:54 得分 0

.Top

18 楼fraser01（王晓栋）回复于 2001-12-19 16:30:50 得分 75

好，我又修正过了代码为：
Private Sub Command1_Click()
ReplaceChinese
End Sub

Private Sub ReplaceChinese()
Dim i As Integer
Dim arrChinese(0 To 9) As String
Dim strSta As String
arrChinese(0) = "零"
arrChinese(1) = "一"
arrChinese(2) = "二"
arrChinese(3) = "三"
arrChinese(4) = "四"
arrChinese(5) = "五"
arrChinese(6) = "六"
arrChinese(7) = "七"
arrChinese(8) = "八"
arrChinese(9) = "九"
strSta = "元拾百千万拾百千亿拾百千万"
Text2 = ""
For i = 0 To 9
Text1 = Replace(Text1, CStr(i), arrChinese(i))
Next
For i = 1 To Len(Text1)
Text2 = IFZTN(Mid(Text1, Len(Text1) + 1 - i, 1) & Mid(strSta, i, 1), i, strSta) & Text2
Text2 = Replace(Text2, "零零", "零")
Next
For i = 1 To Len(Text1) Step 4
Text2 = Replace(Text2, "零" & Mid(strSta, i, 1), Mid(strSta, i, 1))
Text2 = Replace(Text2, Mid(strSta, i + 4, 1) & Mid(strSta, i, 1), Mid(strSta, i + 4, 1))
Next
End Sub

Private Function IFZTN(strValue As String, intCol As Integer, strVbVal) As String
If InStr(strValue, "零") Then
IFZTN = "零"
If (intCol - 1) Mod 4 = 0 Then IFZTN = Mid(strVbVal, intCol, 1)
Else
IFZTN = strValue
End If
End Function

Top

19 楼dashanshi（大山）回复于 2001-12-19 18:07:18 得分 0

你的答案可以给你分数。Top

20 楼Wisdom_Nil（）回复于 2001-12-19 18:12:02 得分 0

AnsiString __fastcall UpperRMB(double Money)
{
// 转换数值为人民币大写;
const long double MaxMoney = 999999999999.999;
AnsiString Result = "";

if (Money == 0.00){
Result = "零元零角";
}
else{
double absMoney = fabs(Money);
if (absMoney > MaxMoney){
return "溢出";
}
else{
AnsiString strMoney = "";
strMoney = strMoney.sprintf("%16.3f", absMoney).Trim();
int LenOfstrMoney = strMoney.Length();
strMoney.Delete((strMoney.Length() - 3), 1);
LenOfstrMoney--;
// 厘分角圆拾佰仟万拾佰仟亿拾佰仟万拾佰仟亿
AnsiString Unit = "厘分角圆拾佰仟万拾佰仟亿拾佰仟";
AnsiString UpperDigit = "零壹贰叁肆伍陆柒捌玖";
int LenOfLeaveMoney = LenOfstrMoney, TheBit = 0, LastBit = 0;
for (int i = 0; i < LenOfstrMoney; i++){
LastBit = TheBit;
TheBit = StrToInt(strMoney.SubString(LenOfLeaveMoney, 1));
LenOfLeaveMoney--;
strMoney = strMoney.SubString(1, LenOfLeaveMoney);
if (TheBit == 0){
switch (i){
case 3 :
case 7 :
case 11 :
Result = Unit.SubString(i * 2 + 1, 2) + Result;
continue;
}
if (Result.IsEmpty()){
continue;
}
if (LastBit == 0){
continue;
}
Result = UpperDigit.SubString(TheBit * 2 + 1, 2) + Result;
}
else{
Result = UpperDigit.SubString(TheBit * 2 + 1, 2) +
Unit.SubString(i * 2 + 1, 2) + Result;
}
}
}
}
return "币" + Result + "整";
}
Top