求最简单算法

Question

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)

Answer 1

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

Answer 2

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

Answer 3

本人前不久做了一个函数，但多于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
    
    ReturnErrProc:
    NumToCH = CStr(varNum) & ",你他妈的找死啊！"
End Function

Answer 4

本人早期曾采用过递归算法解决，代码如下，功能不如前者。前者可处理小数。
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

Answer 5

我的代码够短了吧，不过没有经过详细测试。
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 SubPrivate Function IFZTN(strValue As String) As String
  If InStr(strValue, "零") Then
     IFZTN = "零"
  Else
     IFZTN = strValue
  End If
End Function

Answer 6

前面的代码有点问题，我零时加了两行，在一个判断函数中：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

Answer 7

好，我又修正过了代码为：
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 SubPrivate 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

Answer 8

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 + "整";
}