|
用到数字转中文大写功能,查看网上提供的方法,都不太满意,决定自己动手 DIY 一个。
- Private CNumber As Variant ' 中文大写数组
- Private CUnit As Variant ' 中文单位数组
- ' 中文大写与单位数组定义
- Private Sub CAPDef()
- If IsEmpty(CNumber) Then CNumber = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
- If IsEmpty(CUnit) Then CUnit = Array("元", "拾", "佰", "仟", "万", "拾", "佰", "仟", "亿", "拾", "佰", "仟", "万", "拾", "佰")
- End Sub
- Public Function CAP(ByVal Number As Double) As String
- Call Application.Volatile ' 强制计算
-
- Select Case Number
- Case Is < 0: Call MsgBox("数字不能小于零"): Exit Function
- Case Is >= 100000000000000#: Call MsgBox("数字必须小于一百万亿"): Exit Function ' 满足双精型数值精度要求
- Case 0: CAP = "零元整": Exit Function
- End Select
- Call CAPDef ' 数组定义
-
- Dim b1 As Boolean, b2 As Boolean, i As Integer, iMod As Integer, iTail As Integer
- Dim iStatus As Long ' 转换控制变量
- Dim dTemp As Double ' 为保证求余和整除运算不溢出而将原数按 1E8 拆分
- Dim asTemp(1 To 17) As String ' 按位寄存数组
-
- iTail = (Number - Int(Number)) * 100: Number = Fix(Number)
- If Number >= 100000000# Then dTemp = Fix(Number / 100000000#): Number = Number - dTemp * 100000000# ' 超过 1E8 时拆分数值
- ' 处理整数部分
- Do
- iMod = Number Mod 10: asTemp(14 - i) = CNumber(LBound(CNumber) + iMod)
- If i Mod 4 = 0 Then ' 位置逻辑
- b1 = False: b2 = False ' 初始化节
- If iMod > 0 Then
- iStatus = iStatus * 4 + 3
- Else
- b1 = True: iStatus = iStatus * 4 + 1
- End If
- Else
- If b1 Then
- If iMod > 0 Then
- b1 = False: iStatus = iStatus * 4 + 3
- Else
- iStatus = iStatus * 4
- End If
- ElseIf b2 Then
- If iMod > 0 Then
- b2 = False: iStatus = iStatus * 4 + 3
- Else
- iStatus = iStatus * 4
- End If
- Else
- If iMod > 0 Then
- iStatus = iStatus * 4 + 3
- Else
- b2 = True: iStatus = iStatus * 4 + 2
- End If
- End If
- End If
- Number = Number \ 10: i = i + 1
- If Number = 0 Then
- If dTemp = 0 Then
- Exit Do ' 完成控制变量计算并退出
- ElseIf i = 8 Then
- Number = dTemp: dTemp = 0
- End If
- End If
- Loop
- For i = 14 - i + 1 To 14
- Select Case iStatus Mod 4
- Case 3: asTemp(i) = asTemp(i) & CUnit(LBound(CUnit) + 14 - i)
- Case 1: asTemp(i) = CUnit(LBound(CUnit) + 14 - i)
- Case 0: asTemp(i) = ""
- End Select
- iStatus = iStatus \ 4
- Next i
- ' 处理小数部分
- If iTail > 0 Then
- iMod = iTail Mod 10: iTail = iTail \ 10
- If iTail = 0 Then
- asTemp(15) = CNumber(LBound(CNumber))
- asTemp(16) = CNumber(LBound(CNumber) + iMod) & "分"
- ElseIf iMod = 0 Then
- asTemp(15) = CNumber(LBound(CNumber) + iTail) & "角"
- asTemp(17) = "整"
- Else
- asTemp(15) = CNumber(LBound(CNumber) + iTail) & "角"
- asTemp(16) = CNumber(LBound(CNumber) + iMod) & "分"
- End If
- Else
- asTemp(17) = "整"
- End If
-
- CAP = Replace(Join(asTemp, ""), "亿万", "亿") ' 每节(四位一节)均为零时修正
- End Function
复制代码 把以上代码放在任意模块上,运行 CAP 方法即可。
|
|