本帖最后由 39660519 于 2022-12-17 08:43 编辑
Function 大写转小写(大写数字)
If 大写数字 = "" Then
大写转小写 = ""
Exit Function
End If
If 大写数字 = "零" Then
大写转小写 = 0
Exit Function
End If
Set 平方值字典 = CreateObject("ScrIptIng.DIctIonary")
Set 字典 = CreateObject("ScrIptIng.DIctIonary")
ARR1 = Array("个", "十", "百", "千", "万", "亿", "兆", "京", "垓", "杼", "穰", "沟", "涧", "正", "载", "极", "恒河沙", "阿僧袛", "那由它", "不可思议", "无量", "大数", "古戈尔")
ARR2 = Array(0, 1, 2, 3, 4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 100)
For A = UBound(ARR1) To 0 Step -1
字典(ARR2(A)) = ARR1(A)
平方值字典(ARR1(A)) = ARR2(A)
Next A
位数 = Application.Max(ARR2) + 1
ReDim ARR(1 To 2, 1 To 位数)
For A = 1 To 位数
ARR(1, A) = A - 1
ARR(2, A) = 0
Next A
ARR3 = Array("一", "二", "三", "四", "五", "六", "七", "八", "九")
ARR4 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
If Left(大写数字, 1) = "十" Then 大写数字 = "一" & 大写数字
Dim 正则对象 As Object
Dim 匹配值集合 As Object, 匹配值 As Object
Set 正则对象 = CreateObject("VBSCRIPT.REGEXP")
With 正则对象
.Global = True
.MultiLine = False
.IgnoreCase = True
.Pattern = "零"
大写数字 = .Replace(大写数字, "")
B = -1
For Each A In ARR3
B = B + 1
.Pattern = A
大写数字 = .Replace(大写数字, ARR4(B))
Next A
If IsNumeric(Right(大写数字, 1)) Then 大写数字 = 大写数字 & "个"
For Each A In ARR1
.Pattern = A
Set 匹配值集合 = .Execute(大写数字)
For Each 匹配值 In 匹配值集合
B = 匹配值.FirstIndex
C = Mid(大写数字, B, 1)
If IsNumeric(C) = False Then
N1 = Mid(大写数字, 1, B)
N2 = Mid(大写数字, B + 1, Len(大写数字) - B)
If A = "十" Then
大写数字 = N1 & 1 & N2
Else
大写数字 = N1 & 0 & N2
End If
End If
Next 匹配值
Next A
.Pattern = "[^0-9]+"
Set 匹配值集合 = .Execute(大写数字)
A = 匹配值集合.Count
基础平方 = 0
For B = A - 1 To 0 Step -1
单位 = 匹配值集合.Item(B).Value
对应平方 = 平方值字典(单位)
If 对应平方 > 基础平方 Then
基础平方 = 对应平方
Else
对应平方 = 对应平方 + 基础平方
End If
ARR(1, 对应平方 + 1) = 对应平方
大写数字 = Mid(大写数字, 1, Len(大写数字) - Len(单位))
ARR(2, 对应平方 + 1) = --Right(大写数字, 1)
大写数字 = Mid(大写数字, 1, Len(大写数字) - 1)
Next B
End With
For A = 1 To 位数
大写转小写 = 大写转小写 + ARR(2, A) * 10 ^ ARR(1, A)
Next A
大写转小写 = 大写转小写 & ""
End Function
|