[已解决]VBS如何实现将中文小写数字转换成阿拉伯数字

xp3000

有大量文本，比如把VBS放在文件夹，一次全部处理，弄成4位的数字。
这些是文本第一行提取的内容，内容有第一节，第二节，第三节……第一千零三十节……
需要处理成第0001节，第0002节，第0003节……第1030节……
而不用处理这类内容：今天考试得了第一，课堂上老师表扬了我。

小写数字转换大写方面能对就好了，
第二个问题是有的是【0001】，【0002】，【0003】……
怎么在这样的内容前面加个第字变成第0001章，第0002章，第0003章……

CrLf

一个示例：

1. MsgBox [大写数字转阿拉伯数字]("第一千零三十节")
   
2. 
   
3. Function [大写数字转阿拉伯数字]([原始字符串])
   
4.         Dim [大写数字],[数字列表]
   
5.        
   
6.         [大写数字] = reReplace([原始字符串],"^[^零一二三四五六七八九十百千两]*","")
   
7.         [大写数字] = reReplace([大写数字],"[^零一二三四五六七八九十百千两].*","")
   
8.         [原始字符串] = reReplace([原始字符串],"[零一二三四五六七八九十百千两]+","#")
   
9.        
   
10.         [数字列表]="零一二三四五六七八九"
    
11.         For i=0 To Len([数字列表])
    
12.                 [大写数字]=Replace([大写数字],Mid([数字列表],i+1,1),"+"&i)
    
13.         Next
    
14.         [大写数字]=Replace([大写数字],"两","+2")
    
15.        
    
16.         [大写数字] = Replace([大写数字],"十","*10")
    
17.         [大写数字] = Replace([大写数字],"百","*100")
    
18.         [大写数字] = Replace([大写数字],"千","*1000")
    
19.         [大写数字] = Mid([大写数字],2)
    
20.         [大写数字转阿拉伯数字] = Replace([原始字符串],"#",Eval([大写数字]))
    
21. End Function
    
22. 
    
23. Function reReplace(string1,pattern,string2)
    
24.         With New RegExp
    
25.                 .Pattern=pattern
    
26.                 reReplace=.Replace(string1,string2)
    
27.         End With
    
28. End Function

复制代码

xp3000

大量TXT首行提取的内容如下，测试了下不能成功：
第一节
第二节
第三节
第四节
第五节
第六节
第七节
第八节
第九节
第十节

apang

回复 3# xp3000


    给一个测试样本，具体说明需要修改成什么样子

xp3000

样本已经发了，有两个需要处理

apang

1. Dim str, fso, file, f, txt
   
2. str = "零一二三四五六七八九十百千"
   
3. Set fso = CreateObject("Scripting.FileSystemObject")
   
4. For Each file in fso.GetFolder(".").Files
   
5.     If LCase(Right(file, 4)) = ".txt" Then
   
6.         Set f = fso.OpenTextFile(file, 1)
   
7.         txt = f.ReadAll
   
8.         f.Close : Set f = Nothing
   
9.         fso.OpenTextFile(file, 2).Write RegEx(txt)
   
10.     End If
    
11. Next
    
12. Set fso = Nothing
    
13. 
    
14. MsgBox "OK"
    
15. 
    
16. Function RegEx(txt)
    
17.     Dim re, s, i, s1, ss
    
18.     Set re = New RegExp
    
19.     re.Pattern = "(第)([" & str & "]+)(节)"
    
20.     If Not re.Test(txt) Then RegEx = txt : Exit Function
    
21.     s = re.Execute(txt)(0).SubMatches(1)
    
22.     If Left(s, 1) = "十" Then s = "一" & s
    
23.     For i = 1 to Len(s)
    
24.         s1 = Mid(s, i, 1)
    
25.         If InStr(str, s1) > 10 Then
    
26.             ss = ss & "*10^" & (InStr(str, s1)-10) & "+"
    
27.         Else ss = ss & (InStr(str, s1)-1)
    
28.         End If
    
29.     Next
    
30.     s = Right("0000" & eval(ss & "+0"), 4)
    
31.     RegEx = re.Replace(txt, "$1" & s & "$3")
    
32. End Function
    

复制代码

第2个，把function部分换成：

1. Function RegEx(txt)
   
2.     Dim re, s
   
3.     Set re = New RegExp
   
4.     re.Pattern = "【(\d+)】"
   
5.     If Not re.Test(txt) Then RegEx = txt : Exit Function
   
6.     s = re.Execute(txt)(0).SubMatches(0)
   
7.     s = Right("0000" & s, 4)
   
8.     RegEx = re.Replace(txt, "第" & s & "节")
   
9. End Function

复制代码

xp3000

回复 6# apang


    不好意思电脑雷给劈了现在才弄好，发现带有第两百字样的章不能转换

CrLf

已修改

apang

回复 7# xp3000


    第19行：

1. re.Pattern = "(第)([" & str & "两]+)(节)"

复制代码

第21行：

1. s = re.Execute(txt)(0).SubMatches(1) : s = Replace(s, "两", "二")

复制代码

话说测试样本中没见到“两”字
108 可以叫 一百单八，可以叫 百又八，可以叫 一百零八，等
总之中文数字叫法很多，如果要求代码兼容所有叫法，估计有难度，具体问题具体分析吧