WORD中英文日期需要批量替换为中文日期

benny_thyj

老师，经测试??-???-2014 这类格式的日期执行代码后成了??-???-214

413191246se

* 请将代码复制到 记事本 中再复制回 VBE 中试试（因我现在用的是新电脑 Win10-x64 + Office2019）。

413191246se

* 楼主，我把 Win10-x64 下的代码转换为 Ansi 格式，试试怎么样：（请做好备份）

1. Sub aaaa英文日期转中文_v2()
   
2.     Dim s$, v&
   
3.     With ActiveDocument.Content.Find
   
4.         .ClearFormatting
   
5.         .Text = "[0-9]{1,2}-[A-Za-z]{3}-[0-9]{4}"
   
6.         .Forward = True
   
7.         .MatchWildcards = True
   
8.         Do While .Execute
   
9.             With .Parent
   
10.                 s = .Text
    
11.                 v = Len(s)
    
12. 
    
13.                 If v = 10 Then
    
14.                     s = Right(s, 4) & "年" & Mid(s, InStr(s, "-") + 1, 3) & Left(s, 1) & "日"
    
15.                 Else
    
16.                     s = Right(s, 4) & "年" & Mid(s, InStr(s, "-") + 1, 3) & Left(s, 2) & "日"
    
17.                 End If
    
18. 
    
19.                 s = Replace(s, "JAN", "1月")
    
20.                 s = Replace(s, "FEB", "2月")
    
21.                 s = Replace(s, "MAR", "3月")
    
22.                 s = Replace(s, "APR", "4月")
    
23.                 s = Replace(s, "MAY", "5月")
    
24.                 s = Replace(s, "JUN", "6月")
    
25.                 s = Replace(s, "JUL", "7月")
    
26.                 s = Replace(s, "AUG", "8月")
    
27.                 s = Replace(s, "SEP", "9月")
    
28.                 s = Replace(s, "OCT", "10月")
    
29.                 s = Replace(s, "NOV", "11月")
    
30.                 s = Replace(s, "DEC", "12月")
    
31.                
    
32.                 s = Replace(s, "Jan", "1月")
    
33.                 s = Replace(s, "Feb", "2月")
    
34.                 s = Replace(s, "Mar", "3月")
    
35.                 s = Replace(s, "Apr", "4月")
    
36.                 s = Replace(s, "May", "5月")
    
37.                 s = Replace(s, "Jun", "6月")
    
38.                 s = Replace(s, "Jul", "7月")
    
39.                 s = Replace(s, "Aug", "8月")
    
40.                 s = Replace(s, "Sep", "9月")
    
41.                 s = Replace(s, "Oct", "10月")
    
42.                 s = Replace(s, "Nov", "11月")
    
43.                 s = Replace(s, "Dec", "12月")
    
44. 
    
45.                 .Text = s
    
46.                 .Font.Color = wdColorRed '红色（此行代码可删除）
    
47.                 .Start = .End
    
48.             End With
    
49.         Loop
    
50.     End With
    
51. 
    
52. '''
    
53.     With ActiveDocument.Content.Find
    
54.         .ClearFormatting
    
55.         .Text = "[A-Za-z]{3}-[0-9]{4}"
    
56.         .Forward = True
    
57.         .MatchWildcards = True
    
58.         Do While .Execute
    
59.             With .Parent
    
60.                 If Len(.Paragraphs(1).Range.Text) > 10 Then GoTo sk
    
61.                 s = .Text
    
62.                 s = Right(s, 4) & "年" & Left(s, 3)
    
63. 
    
64.                 s = Replace(s, "JAN", "1月")
    
65.                 s = Replace(s, "FEB", "2月")
    
66.                 s = Replace(s, "MAR", "3月")
    
67.                 s = Replace(s, "APR", "4月")
    
68.                 s = Replace(s, "MAY", "5月")
    
69.                 s = Replace(s, "JUN", "6月")
    
70.                 s = Replace(s, "JUL", "7月")
    
71.                 s = Replace(s, "AUG", "8月")
    
72.                 s = Replace(s, "SEP", "9月")
    
73.                 s = Replace(s, "OCT", "10月")
    
74.                 s = Replace(s, "NOV", "11月")
    
75.                 s = Replace(s, "DEC", "12月")
    
76.                
    
77.                 s = Replace(s, "Jan", "1月")
    
78.                 s = Replace(s, "Feb", "2月")
    
79.                 s = Replace(s, "Mar", "3月")
    
80.                 s = Replace(s, "Apr", "4月")
    
81.                 s = Replace(s, "May", "5月")
    
82.                 s = Replace(s, "Jun", "6月")
    
83.                 s = Replace(s, "Jul", "7月")
    
84.                 s = Replace(s, "Aug", "8月")
    
85.                 s = Replace(s, "Sep", "9月")
    
86.                 s = Replace(s, "Oct", "10月")
    
87.                 s = Replace(s, "Nov", "11月")
    
88.                 s = Replace(s, "Dec", "12月")
    
89. 
    
90.                 .Text = s
    
91.                 .Font.Color = wdColorPink '粉红（此行代码可删除）
    
92. sk:
    
93.                 .Start = .End
    
94.             End With
    
95.         Loop
    
96.     End With
    
97. 
    
98. '0X月0X日替换
    
99.     With ActiveDocument.Content.Find
    
100.         .Execute "(0)([0-9]月)", , , 1, , , , , , "\2", 2
     
101.         .Execute "(0)([0-9]日)", , , 1, , , , , , "\2", 2
     
102.     End With
     
103. 
     
104.     MsgBox "OK!!!!!!!!!!!!!!!!!!!!!", 0 + 48
     
105. End Sub

复制代码

benny_thyj

413191246se 发表于 2020-3-19 23:19
* 楼主，我把 Win10-x64 下的代码转换为 Ansi 格式，试试怎么样：（请做好备份）

我运行了一下，对于??-???-2017以及??-JAN-2017这种格式内容，代码不执行替换。烦请老师答疑！谢谢！

413191246se

如果“？”是要查找的字符串，则找不到！我认为你是把“？”指代一些数字。
另：如果代码运行不好，请将代码复制到 记事本 中，再另存为 Ansi 格式的 纯文本文件，再复制代码到 VBE 试试。

benny_thyj

413191246se 发表于 2020-3-20 11:04
如果“？”是要查找的字符串，则找不到！我认为你是把“？”指代一些数字。
另：如果代码运行不好，请将代 ...

是查找字符串。可以使用通配符吗？

413191246se

具体查找什么样的字符串呢？请 楼主 举例。——另外，我认为，上面的 v2 版本代码已经解决了你的问题。
——虽然是查找操作，但不同的目的不一定能用同样的代码，具体有区别。

benny_thyj

413191246se 发表于 2020-3-20 14:25
具体查找什么样的字符串呢？请 楼主 举例。——另外，我认为，上面的 v2 版本代码已经解决了你的问题。
— ...

就是我的WORD文档中有一些是明确日期的，如"21-JAN-2017",也有没有具体日期，只有月份的，如"JAN-2017"这两种上面的v2代码已经给予解决了。

还有2种情形就是文档中有文本是"??-???-2017"、"??-Feb-2017"
1）"??-???-2017"这种代表具体的日期和月份不明确，我需要将?号保留，并且将其改为中文日期格式类型，如"2017年??月??日"
2）"??-Feb-2017"这种代表仅仅具体的日期不明确，我也同样将?号保留，并且将其改为中文日期格式类型，如"2017年2月??日"

sylun

也可以试试如下方法，目前的查找代码也匹配纯阿拉伯数字日期文本，如只要匹配含英文月份缩写的日期文本，可修改查找代码：

1. Sub test()
   
2.     Dim i As Integer
   
3.    
   
4.     Application.ScreenUpdating = False
   
5.     With ActiveDocument.Content.Find
   
6.         .MatchWildcards = True
   
7.         Do While .Execute("[0-9A-Za-z-]@-[12][0-9]{3,}")
   
8.             With .Parent
   
9.                 If IsDate(.Text) Then
   
10.                     i = UBound(Split(.Text, "-"))
    
11.                     .Text = Format(.Text, IIf(i = 2, "yyyy年M月d日", "yyyy年M月"))
    
12.                 End If
    
13.                 .Collapse wdCollapseEnd
    
14.             End With
    
15.         Loop
    
16.     End With
    
17.     Application.ScreenUpdating = True
    
18. End Sub

复制代码

413191246se

楼主，sylun 老师 辛苦写的代码，你得试试啊！反馈一下意见。老师辛苦了！谢谢！