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

xp3000

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

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

CrLf

一个示例：

MsgBox [大写数字转阿拉伯数字]("第一千零三十节")

Function [大写数字转阿拉伯数字]([原始字符串])
	Dim [大写数字],[数字列表]
	
	[大写数字] = reReplace([原始字符串],"^[^零一二三四五六七八九十百千两]*","")
	[大写数字] = reReplace([大写数字],"[^零一二三四五六七八九十百千两].*","")
	[原始字符串] = reReplace([原始字符串],"[零一二三四五六七八九十百千两]+","#")
	
	[数字列表]="零一二三四五六七八九"
	For i=0 To Len([数字列表])
		[大写数字]=Replace([大写数字],Mid([数字列表],i+1,1),"+"&i)
	Next
	[大写数字]=Replace([大写数字],"两","+2")
	
	[大写数字] = Replace([大写数字],"十","*10")
	[大写数字] = Replace([大写数字],"百","*100")
	[大写数字] = Replace([大写数字],"千","*1000")
	[大写数字] = Mid([大写数字],2)
	[大写数字转阿拉伯数字] = Replace([原始字符串],"#",Eval([大写数字]))
End Function

Function reReplace(string1,pattern,string2)
	With New RegExp
		.Pattern=pattern
		reReplace=.Replace(string1,string2)
	End With
End Function
复制代码

xp3000

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

apang

回复 3# xp3000


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

xp3000

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

apang

Dim str, fso, file, f, txt
str = "零一二三四五六七八九十百千"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each file in fso.GetFolder(".").Files
    If LCase(Right(file, 4)) = ".txt" Then
        Set f = fso.OpenTextFile(file, 1)
        txt = f.ReadAll
        f.Close : Set f = Nothing
        fso.OpenTextFile(file, 2).Write RegEx(txt)
    End If
Next
Set fso = Nothing

MsgBox "OK"

Function RegEx(txt)
    Dim re, s, i, s1, ss
    Set re = New RegExp
    re.Pattern = "(第)([" & str & "]+)(节)"
    If Not re.Test(txt) Then RegEx = txt : Exit Function
    s = re.Execute(txt)(0).SubMatches(1)
    If Left(s, 1) = "十" Then s = "一" & s
    For i = 1 to Len(s)
        s1 = Mid(s, i, 1)
        If InStr(str, s1) > 10 Then
            ss = ss & "*10^" & (InStr(str, s1)-10) & "+"
        Else ss = ss & (InStr(str, s1)-1)
        End If
    Next
    s = Right("0000" & eval(ss & "+0"), 4)
    RegEx = re.Replace(txt, "$1" & s & "$3")
End Function
复制代码

第2个，把function部分换成：

Function RegEx(txt)
    Dim re, s
    Set re = New RegExp
    re.Pattern = "【(\d+)】"
    If Not re.Test(txt) Then RegEx = txt : Exit Function
    s = re.Execute(txt)(0).SubMatches(0)
    s = Right("0000" & s, 4)
    RegEx = re.Replace(txt, "第" & s & "节")
End Function
复制代码

xp3000

回复 6# apang


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

CrLf

已修改

apang

回复 7# xp3000


    第19行：

re.Pattern = "(第)([" & str & "两]+)(节)"
复制代码

第21行：

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

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