日常办公过程中,特别是财务数据处理过程中我们常常需要将数字形式的金额转换为大写形式,对于外贸型企业可能还需要英文版的大写金额需求。一般实现此功能主要是通过 VBA 自定义函数来实现的。针对于此,我特意收集了下网上此类问题的解决方式,这里分享两种个人认为比较好的中英文金额大写方式。
中文版金额转大写
对于国内,最常使用的应当是金额转中文大写了,具体代码如下:
' 金额转大写(英文版) Function MoneyToChinese(ByVal Num) Application.Volatile True Place = "分角元拾佰仟万拾佰仟亿拾佰仟万" Dn = "壹贰叁肆伍陆柒捌玖" D1 = "整零元零零零万零零零亿零零零万" If Num < 0 Then Mark = "(负)" Num = Format(Abs(Num), "###0.00") * 100 If Num > 999999999999999# Then: MoneyToChinese = "数字超出转换范围!": Exit Function If Num = 0 Then: MoneyToChinese = "零元零分": Exit Function NumA = Trim(Str(Num)) NumLen = Len(NumA) For j = NumLen To 1 Step -1 ' 数字转换过程 Temp = Val(Mid(NumA, NumLen - j + 1, 1)) If Temp <> 0 Then ' 非零数字转换 NumC = NumC & Mid(Dn, Temp, 1) & Mid(Place, j, 1) Else ' 数字零的转换 If Right(NumC, 1) <> "零" Then NumC = NumC & Mid(D1, j, 1) Else Select Case j ' 特殊数位转换 Case 1 NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, j, 1) Case 3, 11 NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, j, 1) & "零" Case 7 If Mid(NumC, Len(NumC) - 1, 1) <> "亿" Then NumC = Left(NumC, Len(NumC) - 1) & Mid(D1, j, 1) & "零" End If Case Else End Select End If End If Next MoneyToChinese = Mark & Trim(NumC) End Function
引用方式:
=MoneyToChinese(Number)
英文版金额转大写
' 金额转大写(英文版) Function MoneyToEnglish(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 " MyNumber = Trim(Str(Round(MyNumber, 2))) DecimalPlace = InStr(MyNumber, ".") If DecimalPlace > 0 Then Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2) Cents = ConvertTens(Temp) MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" Temp = ConvertHundreds(Right(MyNumber, 3)) If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars If Len(MyNumber) > 3 Then MyNumber = Left(MyNumber, Len(MyNumber) - 3) Else MyNumber = "" End If Count = Count + 1 Loop Select Case Dollars Case "" Dollars = "No Dollars" Case "One" Dollars = "One Dollar" Case Else Dollars = Dollars End Select Select Case Cents Case "" Case Is = "" Case "One" Cents = " And One Cent" Case Else Cents = " AND " & "CENTS " & Cents End Select MoneyToEnglish = "SAY U.S.DOLLARS " & Dollars & Cents & " ONLY." End Function Private Function ConvertHundreds(ByVal MyNumber) Dim Result As String If Val(MyNumber) = 0 Then Exit Function 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 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 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
引用方式:
=MoneyToEnglish(Number)
以上。