|
'数级内各数位的单位
Function Unite(ByVal CurrentU As Integer) As String
u = CurrentU Mod 4
Select Case u
Case 1
Unite = ""
Case 2
Unite = "十"
Case 3
Unite = "百"
Case 0
Unite = "千"
End Select
End Function
'生成数级单位
Function LevelUnite(ByVal CurrU As Integer) As String
If CurrU Mod 4 = 1 Then
Select Case CurrU \ 4
Case 0
LevelUnite = ""
Case 1
LevelUnite = "万"
Case 2
LevelUnite = "亿"
Case 3
LevelUnite = "兆"
End Select
Else
LevelUnite = ""
End If
End Function
'转换一个数位上的数
'N 要转换的数字
'u 所在数位
'num_l 转换数的总位数
Function TranCurrNum(N As String, u As Integer, num_l As Integer) As String
Dim num(9) As String
num(1) = "一"
num(2) = "二"
num(3) = "三"
num(4) = "四"
num(5) = "五"
num(6) = "六"
num(7) = "七"
num(8) = "八"
num(9) = "九"
num(0) = "零"
'每级的十位如果是最高位,且数字为1时,以“十”-“十九”出现,不出现“一十几”
If Not (u Mod 4 = 2 And N = "1" And u = num_l) Then
TranCurrNum = num(Asc(N) - 48)
End If
'如果数字为0,则返回零,不附加单位
If N <> "0" Then
TranCurrNum = TranCurrNum & Unite(u)
End If
End Function
'要将小写数转换成大写,就用它了。
Function XtoD(Optional num As String = "", Optional UniteName As String = "") As String
Dim temp As String, temp_l As String, i As Integer
Dim num_len As Integer, num_len_l As Integer
If Len(num) = 0 Then
Exit Function
End If
temp = num & ""
num_len = Len(temp)
For i = 1 To num_len
num_len_l = Len(temp)
temp_l = Left(temp, 1)
If Not (temp_l = "0" And Right(XtoD, 1) = "零") Then
XtoD = XtoD & TranCurrNum(temp_l, num_len_l, num_len)
End If
'每个数级结束时,如末尾有“零”则去掉
If num_len_l Mod 4 = 1 And Right(XtoD, 1) = "零" Then
XtoD = Left(XtoD, Len(XtoD) - 1)
End If
'每个数级末尾加本数级的单位
XtoD = XtoD & LevelUnite(num_len_l)
temp = Mid(temp, 2)
Next i
XtoD = XtoD & UniteName
End Function
|
|