求助 将阿拉伯数字转换成中文数字大写

'对于西文数字，尤其是多位的数字不同的人会有不同的习惯读法，所以并不是唯一的转化规则，但是尽量符合多数人的习惯，所以
'对于部分数字读法，在脚本中做如下规定：
'(1)数字11000规定读做壹万壹仟,而不是简读的壹万壹
'(2)数字100010001000规定读做壹仟亿零壹仟万零壹仟,而不读做壹仟亿壹仟万壹仟
'1兆等于多少亿? 其实有3种算法
'一是自乘算法: 万万为亿，亿亿为兆，兆兆为京。即10^4=万, 10^8=亿,10^16=兆,10^32=京
'二是万进算法，皆以万递进：万 亿 兆 京 垓 秭 穰 均 涧 正 载......(万万为亿 万亿为兆 万兆为京......) ；
'即10^4=万, 10^8=亿,10^12=兆,10^16=京
'三是十进算法，皆以十递进： 万 亿 、兆、京、垓、秭……到了近代，直至解放前我国还流行十进的系统，
'即个、十、百、千、万、亿、兆、京、垓、秭、穰、沟(土旁)、涧、正、载、报，皆以十进，10万为亿，10亿为兆，10兆为京......；
'10^4=万, 10^5=亿,10^6=兆,10^7=京
'现代的科学技术上用的"兆"属於第三法，就是 10^6，即百万。但日常生活中，前两种也有用到。
'此脚本采用的是第1种算法
Set check=New RegExp
check.Pattern="^\d{1,12}$"
While True '循环输入数字并进行转换
Do
num = InputBox ("请输入由西文0-9构成的不超过12位的数字","西文数字转中文")
If num = "" Then WScript.Quit
If check.Test(num) Then
Exit Do
Else
MsgBox "输入内容不符合要求，请重新输入",0,"提示"
End If
Loop
'处理前面带0的情况，如0006
While Left (num, 1) = 0 And Len (num) > 1 '处理全0的情况，如0000
num = Right (num, Len (num) - 1)
WEnd
num_base = num '保留原始有效数字
'西文数字转中文
num = Replace (num, "0", "零")
num = Replace (num, "1", "壹")
num = Replace (num, "2", "贰")
num = Replace (num, "3", "叁")
num = Replace (num, "4", "肆")
num = Replace (num, "5", "伍")
num = Replace (num, "6", "陆")
num = Replace (num, "7", "柒")
num = Replace (num, "8", "捌")
num = Replace (num, "9", "玖")
chr_num = ""
len_num = Len (num)
For i = len_num To 1 Step - 1 '有效位数不定，因此从低位向高位处理
'四个数字一组依次处理
chr4 = ""
For j = 1 to 4
s = Mid (num, i, 1)
If s = "零" Then '处理0的情况，0后面不跟单位
chr4 = s & chr4
Else
Select case j
Case 1
chr4 = chr4 & s
Case 2
chr4 = s & "拾" & chr4
Case 3
chr4 = s & "佰" & chr4
Case 4
chr4 = s & "仟" & chr4
End Select
End If
i = i - 1
If i = 0 Then Exit For '处理位数不整除4的情况
Next
chr4 = Replace (chr4, "零零", "零") '处理连续2个0的情况
chr4 = Replace (chr4, "零零", "零") '在上一条语句的基础上处理3-4个连续0的情况
If Right (chr4, 1) = "零" Then chr4 = Left (chr4, Len (chr4) - 1) '去除分组后，每组后面不读出的0，例如1004000，拆为100'4000后，4000后面不读出的0
chr_num = chr4 & chr_num '将各组数据重新整合到一起
If len_num - i = 4 And len_num > 4 Then chr_num = "万" & chr_num '处理万位情况
If len_num - i = 12 And len_num > 12 Then chr_num = "万" & chr_num '处理万亿情况
If len_num - i = 8 And len_num > 8 Then chr_num = "亿" & chr_num '处理亿位情况
i = i + 1 '处理4位一组循环中变量i自减的处理，因为下一句Next还会减一，因此在这里进行补偿
Next
If Right (chr_num, 2) = "亿万" Then '处理亿位后全为0的情况，例如200000000
chr_num = Replace (chr_num, "亿万", "亿")
ElseIf InStr (chr_num, "亿万") <> 0 Then '处理亿到万位全为0的情况，例如200007000
chr_num = Replace (chr_num, "亿万", "亿零")
End If
'处理类似10001000（多数人习惯读做一千万零一千），但是11000读做一万一千，极端1000100010001000
chr_num = Replace (chr_num, "万亿", "万亿零") '首先处理万亿，这样就不用单独考虑拾万亿、佰万亿或者仟万亿的情况了，例如500000090000000
chr_num = Replace (chr_num, "拾万", "拾万零")
chr_num = Replace (chr_num, "佰万", "佰万零")
chr_num = Replace (chr_num, "仟万", "仟万零")
chr_num = Replace (chr_num, "拾亿", "拾亿零")
chr_num = Replace (chr_num, "佰亿", "佰亿零")
chr_num = Replace (chr_num, "仟亿", "仟亿零")
chr_num = Replace (chr_num, "零亿", "亿") '处理十亿后都为0的情况，如5000000000000000
If Right(chr_num,1)="零" Then chr_num=left(chr_num,Len(chr_num)-1) '去除最后面不读出的0
chr_num = Replace (chr_num, "零零", "零") '处理连续2个0的情况，如处理亿到万位全为0，千位也为0的情况，例如200000009
chr_num = Replace (chr_num, "零零", "零") '在上一条语句的基础上处理3-4个连续0的情况，如1000000000001
If chr_num = "" Then chr_num = "零" '处理整个数字就是0的情况
MsgBox num_base & vbCrLf & chr_num,0,"转换结果"
WEnd