一个数字转中文大写的方法

kdc922

用到数字转中文大写功能，查看网上提供的方法，都不太满意，决定自己动手 DIY 一个。

1. Private CNumber As Variant ' 中文大写数组
   
2. Private CUnit As Variant ' 中文单位数组
   
3. 
   
4. ' 中文大写与单位数组定义
   
5. Private Sub CAPDef()
   
6.     If IsEmpty(CNumber) Then CNumber = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
   
7.     If IsEmpty(CUnit) Then CUnit = Array("元", "拾", "佰", "仟", "万", "拾", "佰", "仟", "亿", "拾", "佰", "仟", "万", "拾", "佰")
   
8. End Sub
   
9. 
   
10. Public Function CAP(ByVal Number As Double) As String
    
11.     Call Application.Volatile ' 强制计算
    
12.    
    
13.     Select Case Number
    
14.     Case Is < 0: Call MsgBox("数字不能小于零"): Exit Function
    
15.     Case Is >= 100000000000000#: Call MsgBox("数字必须小于一百万亿"): Exit Function ' 满足双精型数值精度要求
    
16.     Case 0: CAP = "零元整": Exit Function
    
17.     End Select
    
18. 
    
19.     Call CAPDef ' 数组定义
    
20.    
    
21.     Dim b1 As Boolean, b2 As Boolean, i As Integer, iMod As Integer, iTail As Integer
    
22.     Dim iStatus As Long ' 转换控制变量
    
23.     Dim dTemp As Double ' 为保证求余和整除运算不溢出而将原数按 1E8 拆分
    
24.     Dim asTemp(1 To 17) As String ' 按位寄存数组
    
25.    
    
26.     iTail = (Number - Int(Number)) * 100: Number = Fix(Number)
    
27.     If Number >= 100000000# Then dTemp = Fix(Number / 100000000#): Number = Number - dTemp * 100000000# ' 超过 1E8 时拆分数值
    
28.     ' 处理整数部分
    
29.     Do
    
30.         iMod = Number Mod 10: asTemp(14 - i) = CNumber(LBound(CNumber) + iMod)
    
31.         If i Mod 4 = 0 Then ' 位置逻辑
    
32.             b1 = False: b2 = False ' 初始化节
    
33.             If iMod > 0 Then
    
34.                 iStatus = iStatus * 4 + 3
    
35.             Else
    
36.                 b1 = True: iStatus = iStatus * 4 + 1
    
37.             End If
    
38.         Else
    
39.             If b1 Then
    
40.                 If iMod > 0 Then
    
41.                     b1 = False: iStatus = iStatus * 4 + 3
    
42.                 Else
    
43.                     iStatus = iStatus * 4
    
44.                 End If
    
45.             ElseIf b2 Then
    
46.                 If iMod > 0 Then
    
47.                     b2 = False: iStatus = iStatus * 4 + 3
    
48.                 Else
    
49.                     iStatus = iStatus * 4
    
50.                 End If
    
51.             Else
    
52.                 If iMod > 0 Then
    
53.                     iStatus = iStatus * 4 + 3
    
54.                 Else
    
55.                     b2 = True: iStatus = iStatus * 4 + 2
    
56.                 End If
    
57.             End If
    
58.         End If
    
59.         Number = Number \ 10: i = i + 1
    
60.         If Number = 0 Then
    
61.             If dTemp = 0 Then
    
62.                 Exit Do ' 完成控制变量计算并退出
    
63.             ElseIf i = 8 Then
    
64.                 Number = dTemp: dTemp = 0
    
65.             End If
    
66.         End If
    
67.     Loop
    
68.     For i = 14 - i + 1 To 14
    
69.         Select Case iStatus Mod 4
    
70.         Case 3: asTemp(i) = asTemp(i) & CUnit(LBound(CUnit) + 14 - i)
    
71.         Case 1: asTemp(i) = CUnit(LBound(CUnit) + 14 - i)
    
72.         Case 0: asTemp(i) = ""
    
73.         End Select
    
74.         iStatus = iStatus \ 4
    
75.     Next i
    
76.     ' 处理小数部分
    
77.     If iTail > 0 Then
    
78.         iMod = iTail Mod 10: iTail = iTail \ 10
    
79.         If iTail = 0 Then
    
80.             asTemp(15) = CNumber(LBound(CNumber))
    
81.             asTemp(16) = CNumber(LBound(CNumber) + iMod) & "分"
    
82.         ElseIf iMod = 0 Then
    
83.             asTemp(15) = CNumber(LBound(CNumber) + iTail) & "角"
    
84.             asTemp(17) = "整"
    
85.         Else
    
86.             asTemp(15) = CNumber(LBound(CNumber) + iTail) & "角"
    
87.             asTemp(16) = CNumber(LBound(CNumber) + iMod) & "分"
    
88.         End If
    
89.     Else
    
90.         asTemp(17) = "整"
    
91.     End If
    
92.    
    
93.     CAP = Replace(Join(asTemp, ""), "亿万", "亿") ' 每节（四位一节）均为零时修正
    
94. End Function

复制代码

把以上代码放在任意模块上，运行 CAP 方法即可。