货币金额自动转换为英文大写

wyl851112

近几年一直在海外做财务，日常工作中经常涉及将小写金额转换为英文大写，学习VBA已有两个多月，这两天工作之余抽空编写了一个货币金额自动转换为英文大写的公式，分享给大家，望赐教。如果大家有更好的解决方案，希望能一起探讨交流。

该公式对１０亿以内的数字，可以进行有效转换，已经过实测检验。如果需转换１０亿以上的数字，可添加代码。不过日常汇款／账务操作，一般１０亿内够用了。下面是公式代码：


Function ConVtoEng(n As Single, Optional Curr As String)
    Dim ArrN(0 To 9, 0 To 9), ArrH(0 To 9), nz As Long, n1 As Byte, n2 As Byte, n3 As Byte, n4 As Byte, n5 As Byte, n6 As Byte, n7 As Byte, n8 As Byte, n9 As Byte, s1 As Byte, s2 As Byte, xs As Byte
    If Not IsNumeric(n) Then ConVtoEng = "#N/A"
    If n > 1000000000 Then ConVtoEng = "#N/A"
    '将英文0-99赋值给数值Arrn
    ArrN(0, 0) = "": ArrN(0, 1) = "One": ArrN(0, 2) = "Two": ArrN(0, 3) = "Three": ArrN(0, 4) = "Four": ArrN(0, 5) = "Five": ArrN(0, 6) = "Six": ArrN(0, 7) = "Seven": ArrN(0, 8) = "Eight": ArrN(0, 9) = "Nine"
    ArrN(1, 0) = "Ten": ArrN(1, 1) = "Eleven": ArrN(1, 2) = "Twelve": ArrN(1, 3) = "Thirteen": ArrN(1, 4) = "Fourteen": ArrN(1, 5) = "Fifteen": ArrN(1, 6) = "Sixteen": ArrN(1, 7) = "Seventeen": ArrN(1, 8) = "Eighteen": ArrN(1, 9) = "Nineteen"
    ArrN(2, 0) = "Twenty": ArrN(3, 0) = "Thirty": ArrN(4, 0) = "Forty": ArrN(5, 0) = "Fifty": ArrN(6, 0) = "Sixty": ArrN(7, 0) = "Seventy": ArrN(8, 0) = "Eighty": ArrN(9, 0) = "Ninety"
    Dim i As Byte, y As Byte
    '通过循环将21-99赋值给数组ArrN
    For i = 2 To 9
        For y = 1 To 9
            ArrN(i, y) = ArrN(i, 0) & "-" & ArrN(0, y)
        Next y
    Next i
    '将100-900整数百赋值给数组ArrH
    ArrH(0) = ""
    For i = 1 To 9
        ArrH(i) = ArrN(0, i) & " Hundred"
    Next i
    xs = (Round(n, 2) - Int(n)) * 100 '提取两位小数位数字
    '依次提取整数位各位上的数值，此处运用Mod和Int函数
    n = Int(n)
    n1 = Int(n Mod 10)
    n2 = Int((n Mod 100) / 10)
    n3 = Int((n Mod 1000) / 100)
    n4 = Int((n Mod 10000) / 1000)
    n5 = Int((n Mod 100000) / 10000)
    n6 = Int((n Mod 1000000) / 100000)
    n7 = Int((n Mod 10000000) / 1000000)
    n8 = Int((n Mod 100000000) / 10000000)
    n9 = Int((n Mod 1000000000) / 100000000)
    '先对小数部分进行转换
    Dim X_Str$
    If xs = 0 Then
            X_Str = " Only"
        Else: X_Str = " and " & "Cents " & ArrN(Int(xs / 10), (xs Mod 10)) & " Only"   '100以内数字直接引用Arrn数组中的值
    End If
    '定义各位上的字符变量
    Dim StrH1$, StrT1$, u$, StrH2$, StrT2$, N_Str$, N_Str1$, StrH3$, StrT3$, N_Str2$  'StrH对应Hundred，取数自数组Arrh；StrT对应十和个位，取数自ArrN数组
    Select Case n
        Case Is = 0
            N_Str = "Zero" & X_Str
        Case Is < 1000
            StrH1 = ArrH(n3): StrT1 = ArrN(n2, n1)    '引用数组中的字符
            If StrH1 <> "" And StrT1 <> "" Then
                    N_Str = StrH1 & " and " & StrT1 & X_Str
                Else
                    N_Str = StrH1 & " " & StrT1 & X_Str
            End If
        Case Is < 1000000
            StrH1 = ArrH(n3): StrT1 = ArrN(n2, n1): StrH2 = ArrH(n6): StrT2 = ArrN(n5, n4) '引用数组中的字符
            If StrT1 = "" Then
                    N_Str1 = StrH1 & StrT1 & X_Str
                Else
                    N_Str1 = StrH1 & " and " & StrT1 & X_Str
            End If
            If StrH2 <> "" And StrT2 <> "" Then
                    N_Str = StrH2 & " and " & StrT2 & " Thousand " & N_Str1
                Else
                    N_Str = StrH2 & " " & StrT2 & " Thousand " & N_Str1
            End If
        Case Is < 1000000000
            StrH1 = ArrH(n3): StrT1 = ArrN(n2, n1): StrH2 = ArrH(n6): StrT2 = ArrN(n5, n4)
            StrH3 = ArrH(n9): StrT3 = ArrN(n8, n7)
            If StrT1 = "" Then
                    N_Str1 = StrH1 & StrT1 & X_Str
                Else
                    N_Str1 = StrH1 & " and " & StrT1 & X_Str
            End If
            If StrT2 <> "" Then
                    N_Str2 = StrH2 & " and " & StrT2 & " Thousand " & N_Str1
                ElseIf StrH2 <> "" Then
                        N_Str2 = StrH2 & " Thousand " & N_Str1
                    Else
                        N_Str2 = N_Str1
            End If
            If StrH3 <> "" And StrT3 <> "" Then
                    N_Str = StrH3 & " and " & StrT3 & " Million " & N_Str2
                Else
                    N_Str = StrH3 & " " & StrT3 & " Million " & N_Str2
            End If
    End Select
    ConVtoEng = Curr & " " & N_Str
End Function

wyl851112

更正：多次测试后，需要将Function ConVtoEng(n As Single, Optional Curr As String)中 N参数修改为 Variant，即ConVtoEng(n As Variant, Optional Curr As String)否则个别情况下会出现错误。

wyl851112

附上excel实例。

踏破拖鞋

点个赞，比较实用

grf1973

以前做过一个1-999的，小改一下即可通用到1亿以内。

1. Function SpellNum(n)    '10^9以内数字转英文
   
2.     If Not IsNumeric(n) Then SpellNum = "#N/A": Exit Function
   
3.     If n > 10 ^ 9 Then SpellNum = "#N/A": Exit Function
   
4.     x1 = "One,Two,Three,Four,Five,Six,Seven,Eight,Nine,Ten,Eleven,Twelve,Thirteen,Fourteen,Fifteen,Sixteen,Seventeen,Eighteen,Nineteen"
   
5.     x2 = "Twenty,Thirty,Forty,Fifty,Sixty,Seventy,Eighty,Ninety"
   
6.     x = Int(n)
   
7.     If x < 100 Then
   
8.         If x < 20 Then
   
9.             SpellNum = Split(x1, ",")(x - 1)
   
10.         Else
    
11.             xx = x \ 10: yy = x Mod 10
    
12.             SpellNum = Split(x2, ",")(xx - 2)
    
13.             If yy > 0 Then SpellNum = SpellNum & "-" & SpellNum(yy)
    
14.         End If
    
15.     ElseIf x < 1000 Then
    
16.         xx = x \ 100: yy = x Mod 100
    
17.         SpellNum = SpellNum(xx) & " Hundred"
    
18.         If yy > 0 Then SpellNum = SpellNum & " and " & SpellNum(yy)
    
19.     ElseIf x < 10 ^ 6 Then
    
20.         xx = x \ 1000: yy = x Mod 1000
    
21.         SpellNum = SpellNum(xx) & " Thousand"
    
22.         If yy > 0 Then SpellNum = SpellNum & " " & SpellNum(yy)
    
23.     ElseIf x < 10 ^ 9 Then
    
24.         xx = x \ 10 ^ 6: yy = x Mod 10 ^ 6
    
25.         SpellNum = SpellNum(xx) & " Million"
    
26.         If yy > 0 Then SpellNum = SpellNum & " " & SpellNum(yy)
    
27.     End If
    
28.     cent = Int((n + 0.00001 - x) * 100)
    
29.     If cent > 0 Then SpellNum = SpellNum & " and Cents " & SpellNum(cent)
    
30. End Function

复制代码

i5290667

楼上的没注释，扣3分~