[原创]英文数字及金额大小写的转换

transer

在网上现在要找中文金额的大小写转换现在已经不是很难了，但英文大小写转换没有看到一个很完整的方法，能看到的也都是少"and"连词，少"-"连接符的。也许可能大家用的少一些。
下面是在下总结改进的英文大小写转换，一种是单纯转换数字的，一种是转换金额的，希望对有些朋友有所帮助。
注：因为不等号<>在文中显示不出来，暂时用"#"代替。请使用时退换回去。注意“<”和“>”符号构成的不等号中间不能有空格。
一、数字转换为英文大写
'-------------------------------------------------------------------
Function NumbToEnglish(ByVal MyNumber)
         Dim Temp
         Dim Inte, Dec
         Dim DecimalPlace, Count
         ReDim Place(9) As String
         Place(2) = " Thousand "
         Place(3) = " Million "
         Place(4) = " Billion "
         Place(5) = " Trillion "
         ' 将数字Mynumber转换成字符串格式，并去掉多余空格
         MyNumber = Trim(Str(MyNumber))
         ' 查找小数点“.”位置
         DecimalPlace = InStr(MyNumber, ".")
         ' 如果找到小数点...
         If DecimalPlace > 0 Then
            ' 转换小数部分
            Temp = Len(Mid(MyNumber, DecimalPlace + 1))
            Count = 1
            Dec = ""
            Do While Count - 1 # Temp
            Dec = Dec & " " & ConvertDecimal(Mid(MyNumber, DecimalPlace + Count, 1))
            Count = Count + 1
            Loop
            ' 去掉小数部分，保留剩下的整数部分留做转换
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
         End If
         Count = 1
         Do While MyNumber # ""
            ' 将最后的三位数字转换成英文数字
            Temp = ConvertHundreds(Right(MyNumber, 3))
            If Temp # "" Then Inte = Temp & Place(Count) & Inte
            If Len(MyNumber) > 3 Then
               ' 如果整数部分大于三位，再向前移动三位数字重复进行转换
               MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
               MyNumber = ""
            End If
            Count = Count + 1
         Loop
         
         ' 增加小数点描述
         If Dec = "" Then
            If Inte = "" Then
            Dec = "No Number!"
            End If
         Else
            If Inte = "" Then
            Dec = "Zero Point" & Dec
            Else
            Dec = " Point" & Dec
            End If
         End If
         NumbToEnglish = Inte & Dec
      End Function
     ' 定义子函数，转换百位数
     Private Function ConvertHundreds(ByVal MyNumber)
         Dim Result As String
         ' 如果数字为空，退出.
         If Val(MyNumber) = 0 Then Exit Function
         ' 在不满三位数的数字前补"0".
         MyNumber = Right("000" & MyNumber, 3)
         ' 判断是否有百位数可供转换?
         If Left(MyNumber, 1) # "0" Then
            If Right("000" & MyNumber, 2) # 0 Then
            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred and "
            Else
            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
            End If
         End If
         ' 判断是否有十位数可供转换?
         If Mid(MyNumber, 2, 1) # "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            ' 如果没有，转换个位数.
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If
         ConvertHundreds = Trim(Result)
      End Function
      ' 定义子函数，转换十位数
      Private Function ConvertTens(ByVal MyTens)
         Dim Result As String
         ' 判断数字是否在 10 - 19 之间?
         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(MyTens)
               Case 10: Result = "Ten"
               Case 11: Result = "Eleven"
               Case 12: Result = "Twelve"
               Case 13: Result = "Thirteen"
               Case 14: Result = "Fourteen"
               Case 15: Result = "Fifteen"
               Case 16: Result = "Sixteen"
               Case 17: Result = "Seventeen"
               Case 18: Result = "Eighteen"
               Case 19: Result = "Nineteen"
               Case Else
            End Select
         Else
            ' .. 否则,它是介于 20 - 99 之间.
            Select Case Val(Left(MyTens, 1))
               Case 2: Result = "Twenty"
               Case 3: Result = "Thirty"
               Case 4: Result = "Forty"
               Case 5: Result = "Fifty"
               Case 6: Result = "Sixty"
               Case 7: Result = "Seventy"
               Case 8: Result = "Eighty"
               Case 9: Result = "Ninety"
               Case Else
            End Select
            ' 转换其中的个位数.
            If Val(Right(MyTens, 1)) = 0 Then
            Result = Result & " " & ConvertDigit(Right(MyTens, 1))
            Else
            Result = Result & "-" & ConvertDigit(Right(MyTens, 1))
            End If
         End If
         ConvertTens = Result
     End Function
      ' 定义子函数，转换个位数
      Private Function ConvertDigit(ByVal MyDigit)
         Select Case Val(MyDigit)
            Case 1: ConvertDigit = "One"
            Case 2: ConvertDigit = "Two"
            Case 3: ConvertDigit = "Three"
            Case 4: ConvertDigit = "Four"
            Case 5: ConvertDigit = "Five"
            Case 6: ConvertDigit = "Six"
            Case 7: ConvertDigit = "Seven"
            Case 8: ConvertDigit = "Eight"
            Case 9: ConvertDigit = "Nine"
            Case Else: ConvertDigit = ""
         End Select
      End Function
      ' 定义子函数，转换小数部分
      Private Function ConvertDecimal(ByVal MyDecimal)
         Select Case Val(MyDecimal)
            Case 1: ConvertDecimal = "One"
            Case 2: ConvertDecimal = "Two"
            Case 3: ConvertDecimal = "Three"
            Case 4: ConvertDecimal = "Four"
            Case 5: ConvertDecimal = "Five"
            Case 6: ConvertDecimal = "Six"
            Case 7: ConvertDecimal = "Seven"
            Case 8: ConvertDecimal = "Eight"
            Case 9: ConvertDecimal = "Nine"
            Case Else: ConvertDecimal = "Zero"
         End Select
      End Function
二?数字金额转化为英文大写金额
'-------------------------------------------------------------------------------------------
Function ConvertCurrencyToEnglish(ByVal MyNumber)
         Dim Temp
         Dim Dollars, Cents
         Dim DecimalPlace, Count
         ReDim Place(9) As String
         Place(2) = " Thousand "
         Place(3) = " Million "
         Place(4) = " Billion "
         Place(5) = " Trillion "
         ' Convert MyNumber to a string, trimming extra spaces.
         MyNumber = Trim(Str(Round(MyNumber, 2)))
         ' Find decimal place.
         DecimalPlace = InStr(MyNumber, ".")
         ' If we find decimal place...
         If DecimalPlace > 0 Then
            ' Convert cents
            Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)
            ' Strip off cents from remainder to convert.
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
         End If
         Count = 1
         Do While MyNumber # ""
            ' Convert last 3 digits of MyNumber to English dollars.
            Temp = ConvertHundreds(Right(MyNumber, 3))
            If Temp # "" Then Dollars = Temp & Place(Count) & Dollars
            If Len(MyNumber) > 3 Then
               ' Remove last 3 converted digits from MyNumber.
               MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
               MyNumber = ""
            End If
            Count = Count + 1
         Loop
         ' Clean up dollars.
         Select Case Dollars
            Case ""
               Dollars = "No Dollars"
            Case "One"
               Dollars = "One Dollar"
            Case Else
               Dollars = Dollars & " Dollars"
         End Select
         ' Clean up cents.
         Select Case Cents
            Case ""
               Cents = " Only"
            Case "One"
               Cents = " And One Cent"
            Case Else
               Cents = " And " & Cents & " Cents"
         End Select
         ConvertCurrencyToEnglish = Dollars & Cents
      End Function
     Private Function ConvertHundreds(ByVal MyNumber)
         Dim Result As String
         ' Exit if there is nothing to convert.
         If Val(MyNumber) = 0 Then Exit Function
         ' Append leading zeros to number.
         MyNumber = Right("000" & MyNumber, 3)
         ' Do we have a hundreds place digit to convert?
         If Left(MyNumber, 1) # "0" Then
            If Right("000" & MyNumber, 2) # 0 Then
            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred and "
            Else
            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
            End If
        End If
         ' Do we have a tens place digit to convert?
         If Mid(MyNumber, 2, 1) # "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            ' If not, then convert the ones place digit.
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If
         ConvertHundreds = Trim(Result)
      End Function
      Private Function ConvertTens(ByVal MyTens)
         Dim Result As String
         ' Is value between 10 and 19?
         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(MyTens)
               Case 10: Result = "Ten"
               Case 11: Result = "Eleven"
               Case 12: Result = "Twelve"
               Case 13: Result = "Thirteen"
               Case 14: Result = "Fourteen"
               Case 15: Result = "Fifteen"
               Case 16: Result = "Sixteen"
               Case 17: Result = "Seventeen"
               Case 18: Result = "Eighteen"
               Case 19: Result = "Nineteen"
               Case Else
            End Select
         Else
            ' .. otherwise it's between 20 and 99.
            Select Case Val(Left(MyTens, 1))
               Case 2: Result = "Twenty"
               Case 3: Result = "Thirty"
               Case 4: Result = "Forty"
               Case 5: Result = "Fifty"
               Case 6: Result = "Sixty"
               Case 7: Result = "Seventy"
               Case 8: Result = "Eighty"
               Case 9: Result = "Ninety"
               Case Else
            End Select
            ' Convert ones place digit.
            If Val(Right(MyTens, 1)) = 0 Then
            Result = Result & " " & ConvertDigit(Right(MyTens, 1))
            Else
            Result = Result & "-" & ConvertDigit(Right(MyTens, 1))
            End If
        End If
         ConvertTens = Result
     End Function
      Private Function ConvertDigit(ByVal MyDigit)
         Select Case Val(MyDigit)
            Case 1: ConvertDigit = "One"
            Case 2: ConvertDigit = "Two"
            Case 3: ConvertDigit = "Three"
            Case 4: ConvertDigit = "Four"
            Case 5: ConvertDigit = "Five"
            Case 6: ConvertDigit = "Six"
            Case 7: ConvertDigit = "Seven"
            Case 8: ConvertDigit = "Eight"
            Case 9: ConvertDigit = "Nine"
            Case Else: ConvertDigit = ""
         End Select
      End Function

[此贴子已经被作者于2006-2-24 15:32:57编辑过]

zw1028

<P>请将代码放入模块中试试，有不少问题，包括二义性问题。等待！！</P>

transer

<P>代码没错，只是，我才发现，代码贴进去之后，所有的"&lt;&gt;"不等号都不自动去掉了！好奇怪。我想个办法替换一下</P>[em09]

zw1028

<P>不好意思，看到了您的修改，谢谢！但是放到模块里，还是有问题！请您再看看？</P>

transer

<P>重新修改了一下，应该没问题了。</P><P>请把“#”换成不等号"&lt; &gt;"。<br>刚刚是因为，我少替换了两个“#”，所以有两处不等号没显示出来。</P><P>好奇怪，我很少发贴，贴一次还碰到不等号显示不出来，哎~。可更奇怪的是，我的回复中不等号"&lt; &gt;"就能显示出来了？！？</P>

[此贴子已经被作者于2006-2-24 15:38:46编辑过]

zw1028

这下全对了，不过那个“二义性”的问题还是没有解决：在“二、数字金额转化为英文大写金额”的第二个自定义函数：“Private Function ConvertHundreds(ByVal MyNumber)”，也就是“ConvertHundreds”有重名，重名在：“' 定义子函数，转换百位数　Private Function ConvertHundreds(ByVal MyNumber)”，这里面牵涉到共同调用的问题，如果不是完全一样，是否把函数名略改一下，或者改成：“ConvertHundreds１”等等！不好意思，有点指手画脚了，对不起！首先应该是谢谢了！！！　

[此贴子已经被作者于2006-2-24 15:57:33编辑过]

transer

<P>呵呵，你说的也对。我两个函数里面的参数和子函数是有好多重复的地方。</P>
<P>不过也不必那么麻烦，你在两个不同的模块中分别插入这两个函数就一点冲突都没有了。呵呵。不客气，也谢谢你的更正。</P>

zw1028

<P>不过话的说回来，您的这个东西确实是好东西，很有用！谢谢您的共享，收下，收藏！</P>

transer

好东西就要分享嘛，有空多交流，您经验丰富。我初来乍到，还望多指教[em02]

07241

<P>不错，谢谢</P>
<P>但是还请楼主看一下，代码加入and的必要条件是百位数不等于0，如果百位数等于0，那么结果还是不对，比如1001</P>