【word通配符】将汉字数字项，批量替换成阿拉伯数字

word 大写汉字 替换阿拉伯数字
这个……用查找替换能搞定.假若从第一章开始能这样
先在文档中任意位置按ctrl+F9插入域括号,在括号中输入 seq a ,选中该域（含括号）,剪切.
打开替换框,查找内容：(^13第)[一二三四五六七八九十?百千万]{1,}(章)
替换为：\1^c\2
高级选项勾选使用通配符,所有替换.
\1^c\2
这个答案还行，前提是所有数字是连续1，2，3依次增加

因为我sb，把宏放normal里结果丢失了宏。
我说一下思路吧，录制一个宏，放文档里，内容是查找如下文字
[一二三四五六七八九零〇十百千万亿]{1,}
使用通配符，完成后编辑，其中execute改成有返回值的，通过这个返回值是否为真确定是否继续循环。
将selection.text通过一个函数修改为数字
函数思路是倒着读字符串，读到十百千，权1改成10的对应次方，万亿权2改成10000的对应次方，一到九把数字和权值1，2乘后累加，最后返回值类型改为字符串

word 2003 不成功
我改成了下面的宏
Sub A()
'宏在 2018-06-08 由 EnterCenter 创建
Selection.HomeKey Unit:=wdStory
Ax = 1
An:
Selection.Find.Execute FindText:="(第)([一二三四五六七八九十?百千万]{1,})(章)", Forward:=True, Replace:=wdReplaceOne, Wrap:=wdFindContinue, MatchWildcards:=True, ReplaceWith:="\1" + CStr(Ax) + "\3"
Ax = Ax + 1
If Ax = 60 Then GoTo An1 '最多改到59
If Selection.Find.Found Then GoTo An '找到替换后转去找下一个
An1:
End Sub

请问楼主解决了没有

请问楼主解决了没有

请问楼主解决了没有，我也想知道答案

弱弱地问一声，这样正文里会被改掉吗？

用excel筛选章节头，用函数替换成汉字解决了。

我最近也有这样的需求，让AI帮我写了一个，初步测试好像没问题
Sub ReplaceChineseWithArabic() Dim wdDoc As Object Set wdDoc = ActiveDocument ' 使用正则表达式查找所有“第X条”格式并进行替换 With CreateObject("VBScript.RegExp") .Global = True .IgnoreCase = True .Pattern = "第([\u4e00-\u9fa5]+)条" Dim matches As Object, match As Object If .Test(wdDoc.Content.Text) Then Set matches = .Execute(wdDoc.Content.Text) Dim replacements As Object Set replacements = CreateObject("Scripting.Dictionary") For Each match In matches Dim chineseNumeral As String chineseNumeral = match.SubMatches(0) ' 如果是汉字数字，则进行转换 Dim arabicNumeral As String arabicNumeral = ChineseToArabic(chineseNumeral) ' 记录需要替换的内容 replacements(match.Value) = "第" & arabicNumeral & "条" Next match ' 批量替换 Dim key As Variant For Each key In replacements.Keys wdDoc.Content.Find.Execute FindText:=key, ReplaceWith:=replacements(key), Replace:=2 ' wdReplaceAll = 2 Next key End If End With MsgBox "汉字数字已全部替换为阿拉伯数字！" ' 清理 Set wdDoc = NothingEnd Sub' 函数：将汉字数字转换为阿拉伯数字Function ChineseToArabic(chineseNumeral As String) As String Dim chineseNumerals As Object Set chineseNumerals = CreateObject("Scripting.Dictionary") chineseNumerals.Add "零", 0 chineseNumerals.Add "一", 1 chineseNumerals.Add "二", 2 chineseNumerals.Add "三", 3 chineseNumerals.Add "四", 4 chineseNumerals.Add "五", 5 chineseNumerals.Add "六", 6 chineseNumerals.Add "七", 7 chineseNumerals.Add "八", 8 chineseNumerals.Add "九", 9 chineseNumerals.Add "十", 10 chineseNumerals.Add "百", 100 chineseNumerals.Add "千", 1000 chineseNumerals.Add "万", 10000 Dim result As Integer Dim temp As Integer Dim unit As Integer Dim prevUnit As Integer Dim i As Integer Dim ch As String result = 0 temp = 0 unit = 1 For i = Len(chineseNumeral) To 1 Step -1 ch = Mid(chineseNumeral, i, 1) If chineseNumerals.exists(ch) Then If chineseNumerals(ch) >= 10 Then If chineseNumerals(ch) > prevUnit Then unit = chineseNumerals(ch) temp = 0 Else temp = temp * chineseNumerals(ch) unit = chineseNumerals(ch) End If Else temp = temp + chineseNumerals(ch) result = result + temp * unit temp = 0 unit = 1 End If prevUnit = chineseNumerals(ch) End If Next i ' 处理最后的单位 If temp > 0 Then result = result + temp * unit End If ChineseToArabic = CStr(result)End Function