三种不规范日期转换为规范公文数字日期

batmanbbs

哈哈，才看到老师的话。

老师，我这个代码是你在问我上一段修改VBEE老师代码是不是用在老师这个3in1代码后，临时按照老师的提问编写的，我原来可没有这个功能的代码。而且如果我自己用的话，应该不会只用在落款日期上，应该会使用正则遍历全文来操作（因为针对所有文本，速度肯定没有这个快）。

shenjianrong163

batmanbbs 发表于 2023-7-6 16:47
上面的第7句是可扩展的，可加入全角半角的点，斜杠等等

PS：本来我是很少推广我自己编写的动作的，就 ...

安装了Quicker，弄了两个小时，始终找不到动作文件在哪查看。

batmanbbs

shenjianrong163 发表于 2023-7-8 13:20
安装了Quicker，弄了两个小时，始终找不到动作文件在哪查看。

动作上点击鼠标右键，选择编辑


弹出"编辑动作"窗口右侧"变量定义"窗口中以"vba_"开头的变量中保存都是VBA代码


PS：有问题直接加我Q

shenjianrong163

batmanbbs 发表于 2023-7-8 13:31
shenjianrong163 发表于 2023-7-8 13:20
安装了Quicker，弄了两个小时，始终找不到动作文件在哪查看。

看到了，谢谢老师！

batmanbbs

shenjianrong163 发表于 2023-7-8 13:43
看到了，谢谢老师！

这个动作的代码编写的时间比较早，是去年11月我刚刚开始学习VBA时自己摸索写的。后来，到EH以后才认真学习一些VBA知识后，但是由于底子已经打下了，所以有空只改进了部分代码，没有再进一步优化。

如果你有什么改进完善，也希望能将代码与我分享，谢谢。

413191246se

* 下面的代码，是我去年“日期3合1”(date3in1)宏丢失后，我前几天重写的，感觉比过去的好些：
* batmanbbs 老师 可以参看一下，其实查找时我已经糊涂了！但还算全部能找到所有日期。
* 该宏仅预处理有空格和无空格的所有日期，不是正式的处理日期的宏。

1. Sub DatePre()
   
2.     Const s As String = "[0-9０-９ 　^s^t一二三四五六七八九十零〇○Oo0０Ｏｏ]@"
   
3.     With ActiveDocument.Content
   
4.         Do
   
5.             With .Find
   
6.                 .ClearFormatting
   
7.                 .Text = "^13" & s & "?" & s & "*^13"
   
8.                 .Forward = True
   
9.                 .MatchWildcards = True
   
10.                 .Execute
    
11.                 With .Parent
    
12.                     If Len(.Text) = 0 Then Exit Sub
    
13.                     .MoveStart
    
14.                     If .Text Like "[2２二]*[日月0-9０-９]?" Then
    
15.                         .Find.Execute "[ 　^s^t]", , , 1, , , , , , "", 2
    
16.                         .CharacterWidth = wdWidthHalfWidth
    
17. 
    
18.                         If .Text Like "20##年*月*" And Len(.Text) <= 12 Then
    
19. 
    
20.                         ElseIf .Text Like "20##[!0-9]*#*" And Len(.Text) <= 11 Then
    
21.                             .Characters(5).Text = "年"
    
22.                             If .Text Like "*年#?" Or .Text Like "*年##?" Then
    
23.                                 .Characters.Last.InsertBefore Text:="月"
    
24.                             Else
    
25.                                 If .Text Like "*年#?#?" Or .Text Like "*年#?##?" Then
    
26.                                     .Characters(7).Text = "月"
    
27.                                 ElseIf .Text Like "*年##?#?" Or .Text Like "*年##?##?" Then
    
28.                                     .Characters(8).Text = "月"
    
29.                                 End If
    
30.                                 .Characters.Last.InsertBefore Text:="日"
    
31.                             End If
    
32. 
    
33.                         ElseIf .Text Like "二???年*月*" And Len(.Text) <= 13 Then
    
34.                             Dim t$
    
35.                             t = .Text
    
36. 
    
37.                             t = Replace(t, "一", "1")
    
38.                             t = Replace(t, "二", "2")
    
39.                             t = Replace(t, "三", "3")
    
40.                             t = Replace(t, "四", "4")
    
41.                             t = Replace(t, "五", "5")
    
42.                             t = Replace(t, "六", "6")
    
43.                             t = Replace(t, "七", "7")
    
44.                             t = Replace(t, "八", "8")
    
45.                             t = Replace(t, "九", "9")
    
46.                             t = Replace(t, "零", "0")
    
47.                             t = Replace(t, "〇", "0")
    
48.                             t = Replace(t, "○", "0")
    
49.                             t = Replace(t, "O", "0")
    
50.                             t = Replace(t, "O", "0")
    
51.                             t = Replace(t, "0", "0")
    
52.                             t = Replace(t, "０", "0")
    
53.                             t = Replace(t, "Ｏ", "0")
    
54.                             t = Replace(t, "ｏ", "0")
    
55. 
    
56.                             If t Like "*年十月*" Then
    
57.                                 t = Replace(t, "十", "10", 1, 1)
    
58.                             ElseIf t Like "*年十?月*" Then
    
59.                                 t = Replace(t, "十", "1", 1, 1)
    
60.                             End If
    
61. 
    
62.                             If t Like "*月?十?日?" Then
    
63.                                 t = Replace(t, "十", "")
    
64.                             ElseIf t Like "*月十?日?" Then
    
65.                                 t = Replace(t, "十", "1")
    
66.                             End If
    
67. 
    
68.                             .Text = t
    
69.                         End If
    
70.                     End If
    
71.                     .Start = .End
    
72.                     .End = .End - 1
    
73.                 End With
    
74.             End With
    
75.         Loop
    
76.     End With
    
77. End Sub

复制代码

413191246se

补充说明一下：现在要自动处理公文，不像过去我只认一种格式“2024年2月9日”，现在共有 5 种格式了！
* 2024年2月9日（数字日期）
* 2024-2-9（数字日期，无“年月日”）
* 二零二四年二月九日（汉字日期）
* 2024年2月（无日期）
* 二零二四年二月（无日期）
*** 更有甚者，有些朋友恐怕别人看不清落款日期，在打字录入的时候，会在日期中加上若干空格！
针对这种新形势，我前几天重写了 DatePre（日期预处理）宏，楼上的宏就是，完美地解决了不规范日期。但此宏并不是正式处理日期的宏，仅仅是预处理；处理日期的宏叫 Inscribe（落款）宏。

文化属性666

batmanbbs 发表于 2023-7-6 13:54

太好了，执行一次通过

chipower

413191246se 发表于 2024-2-9 02:03
补充说明一下：现在要自动处理公文，不像过去我只认一种格式“2024年2月9日”，现在共有 5 种格式了！
* 2 ...

楼主什么时候方便，更新一下您的自动处理公文的宏，2019-2023都更新了，差了2024年，感觉少点啥

413191246se

谢谢楼上朋友！前些天我也有上传更新版本的打算，但因精力有限、天气火热，我又爱玩游戏（最近又重新玩起 CSOL，以前玩 CODOL、NFSOL），现在有一个不成熟的版本。