数字转汉字（宏）Num2Chn

413191246se

* 前几天，在回复坛友《中华人民共和国民法典》的过程中，用我的《第一章》宏排版发现最后 Word 2019 出现“内存溢出”提示，因为该《法典》有 1260 条，可能是其中的域“CHINESENUM2”或“CHINESENUM3”出错，它无法处理这么多条，将阿拉伯数字转换为汉字数目字（比如将“260”转换为“二百六十”），也许是流程导致的内存紧张，不得而知！但不管是不是这个原因，我要抛弃“CHINESENUM2/3”域，改用“直译法”将数字转为汉字。
   
* 功能：将自然数（小于等于9999）转换为汉字数目字（比如将“1260”转换为“一千二百六十”）。
  
* 下面的宏经过测试，正确无误（稍后我会将此宏加入新编《第一条超强版》宏，最大可以处理 9999 条法律条文），有需要的朋友请试用：

1. Sub Num2Chn()
   
2. '数字转汉字/TEST-OK
   
3.     Dim strNum$, lngLen&, lngCnt&, SglNum$, strSum$
   
4.     strNum = 0
   
5.     lngLen = Len(strNum)
   
6.     strSum = ""
   
7.     For lngCnt = 1 To lngLen
   
8.         SglNum = Mid(strNum, lngCnt, 1)
   
9.         SglNum = Replace(SglNum, "1", "一")
   
10.         SglNum = Replace(SglNum, "2", "二")
    
11.         SglNum = Replace(SglNum, "3", "三")
    
12.         SglNum = Replace(SglNum, "4", "四")
    
13.         SglNum = Replace(SglNum, "5", "五")
    
14.         SglNum = Replace(SglNum, "6", "六")
    
15.         SglNum = Replace(SglNum, "7", "七")
    
16.         SglNum = Replace(SglNum, "8", "八")
    
17.         SglNum = Replace(SglNum, "9", "九")
    
18.         SglNum = Replace(SglNum, "0", "零")
    
19.         strSum = strSum & SglNum
    
20.     Next
    
21.     If lngLen = 2 Then
    
22.         strSum = Left(strSum, 1) & "十" & Right(strSum, 1)
    
23.         strSum = Replace(strSum, "一十", "十")
    
24.         strSum = Replace(strSum, "十零", "十")
    
25.     ElseIf lngLen = 3 Then
    
26.         strSum = Left(strSum, 1) & "百" & Mid(strSum, 2, 1) & "十" & Right(strSum, 1)
    
27.         strSum = Replace(strSum, "十零", "十")
    
28.         strSum = Replace(strSum, "零十", "零")
    
29.         If strSum Like "?百零" Then strSum = Replace(strSum, "百零", "百")
    
30.     ElseIf lngLen = 4 Then
    
31.         strSum = Left(strSum, 1) & "千" & Mid(strSum, 2, 1) & "百" & Mid(strSum, 3, 1) & "十" & Right(strSum, 1)
    
32.         strSum = Replace(strSum, "十零", "十")
    
33.         strSum = Replace(strSum, "零十", "零")
    
34.         strSum = Replace(strSum, "零百", "零")
    
35.         If Not strSum Like "*百零?" Then strSum = Replace(strSum, "百零", "百")
    
36.         strSum = Replace(strSum, "零零", "零")
    
37.         If strSum Like "?千零" Then strSum = Replace(strSum, "千零", "千")
    
38.     End If
    
39.     MsgBox strNum & "/" & strSum
    
40. End Sub

复制代码

413191246se

* 后记：昨晚测试《第一条超强版》宏发现，《民法典》共1260条，但我运行宏后，等了很久很久，最终，我结束了它，看到宏运行设置到1000多条了，随后 Word2019 也报错了。
* 总结：Word 软件是个不错的软件，但它只适合编辑排版较小的一些文档，太大就有可能反应迟钝，甚至报错、崩溃。所以，强烈建议不宜用 Word 编辑超大型文档，最好是拆分成子文档，这样用 VBA 宏处理起来也会好用一些。
*《第一条超强版》宏我暂时封印起来，下面会学习研究一下文档拆分了。

xiaoyouxi01

楼主这么一说，我也去试了一下，结果：
用vba去进行替换时“Selection.Find.Execute Replace:=wdReplaceAll”，word直接闪退了。。。

413191246se

楼上朋友，你的替换代码并不正确。

相见是缘8

413191246se 发表于 2020-12-20 09:24
* 后记：昨晚测试《第一条超强版》宏发现，《民法典》共1260条，但我运行宏后，等了很久很久，最终，我结束 ...

老师好！
你真是一个“孜孜不倦，一丝不苟”的人！真值得大家学习和尊重！

loquat

完全可以把你的数字改金额大写稍作修改，就可以通用啊

loquat

调用示例：
txt = selection.text
if isnumeric(txt) then selection.text = getchinesenum3(txt,"数字大写：")

loquat

代码中还有“拾”“佰”“仟”未改过成“十百千”

413191246se

* 相见是缘8 ：过奖了！我有时是凭兴趣来编程的。
* loquat 老师：我只是为了“第一条”自动编号而写，并非想用于金额转换。

dongdonggege

loquat 发表于 2020-12-21 09:55
完全可以把你的数字改金额大写稍作修改，就可以通用啊

老师，你的程序到Do While InStr(l, aTemp, "零零")，就会出错。请指点，谢谢。