ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: 413191246se

[求助] 三种不规范日期转换为规范公文数字日期

[复制链接]

TA的精华主题

TA的得分主题

发表于 2023-7-6 19:11 | 显示全部楼层
哈哈,才看到老师的话。

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

TA的精华主题

TA的得分主题

发表于 2023-7-8 13:20 | 显示全部楼层
batmanbbs 发表于 2023-7-6 16:47
上面的第7句是可扩展的,可加入全角半角的点,斜杠等等

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

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

TA的精华主题

TA的得分主题

发表于 2023-7-8 13:31 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 batmanbbs 于 2023-7-8 13:42 编辑

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


动作上点击鼠标右键,选择编辑
image.png

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

PS:有问题直接加我Q

TA的精华主题

TA的得分主题

发表于 2023-7-8 13:43 | 显示全部楼层
batmanbbs 发表于 2023-7-8 13:31
shenjianrong163 发表于 2023-7-8 13:20
安装了Quicker,弄了两个小时,始终找不到动作文件在哪查看。

看到了,谢谢老师!

TA的精华主题

TA的得分主题

发表于 2023-7-8 13:48 | 显示全部楼层
shenjianrong163 发表于 2023-7-8 13:43
看到了,谢谢老师!

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

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-2-8 14:13 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
* 下面的代码,是我去年“日期3合1”(date3in1)宏丢失后,我前几天重写的,感觉比过去的好些:
* batmanbbs 老师 可以参看一下,其实查找时我已经糊涂了!但还算全部能找到所有日期。
* 该宏仅预处理有空格和无空格的所有日期,不是正式的处理日期的宏。
  1. Sub DatePre()
  2.     Const s As String = "[0-90-9  ^s^t一二三四五六七八九十零〇○Oo00Oo]@"
  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 "[22二]*[日月0-90-9]?" Then
  15.                         .Find.Execute "[  ^s^t]", , , 1, , , , , , "", 2
  16.                         .CharacterWidth = wdWidthHalfWidth

  17.                         If .Text Like "20##年*月*" And Len(.Text) <= 12 Then

  18.                         ElseIf .Text Like "20##[!0-9]*#*" And Len(.Text) <= 11 Then
  19.                             .Characters(5).Text = "年"
  20.                             If .Text Like "*年#?" Or .Text Like "*年##?" Then
  21.                                 .Characters.Last.InsertBefore Text:="月"
  22.                             Else
  23.                                 If .Text Like "*年#?#?" Or .Text Like "*年#?##?" Then
  24.                                     .Characters(7).Text = "月"
  25.                                 ElseIf .Text Like "*年##?#?" Or .Text Like "*年##?##?" Then
  26.                                     .Characters(8).Text = "月"
  27.                                 End If
  28.                                 .Characters.Last.InsertBefore Text:="日"
  29.                             End If

  30.                         ElseIf .Text Like "二???年*月*" And Len(.Text) <= 13 Then
  31.                             Dim t$
  32.                             t = .Text

  33.                             t = Replace(t, "一", "1")
  34.                             t = Replace(t, "二", "2")
  35.                             t = Replace(t, "三", "3")
  36.                             t = Replace(t, "四", "4")
  37.                             t = Replace(t, "五", "5")
  38.                             t = Replace(t, "六", "6")
  39.                             t = Replace(t, "七", "7")
  40.                             t = Replace(t, "八", "8")
  41.                             t = Replace(t, "九", "9")
  42.                             t = Replace(t, "零", "0")
  43.                             t = Replace(t, "〇", "0")
  44.                             t = Replace(t, "○", "0")
  45.                             t = Replace(t, "O", "0")
  46.                             t = Replace(t, "O", "0")
  47.                             t = Replace(t, "0", "0")
  48.                             t = Replace(t, "0", "0")
  49.                             t = Replace(t, "O", "0")
  50.                             t = Replace(t, "o", "0")

  51.                             If t Like "*年十月*" Then
  52.                                 t = Replace(t, "十", "10", 1, 1)
  53.                             ElseIf t Like "*年十?月*" Then
  54.                                 t = Replace(t, "十", "1", 1, 1)
  55.                             End If

  56.                             If t Like "*月?十?日?" Then
  57.                                 t = Replace(t, "十", "")
  58.                             ElseIf t Like "*月十?日?" Then
  59.                                 t = Replace(t, "十", "1")
  60.                             End If

  61.                             .Text = t
  62.                         End If
  63.                     End If
  64.                     .Start = .End
  65.                     .End = .End - 1
  66.                 End With
  67.             End With
  68.         Loop
  69.     End With
  70. End Sub
复制代码

TA的精华主题

TA的得分主题

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

TA的精华主题

TA的得分主题

发表于 2024-3-13 11:34 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2024-6-5 20:54 | 显示全部楼层
413191246se 发表于 2024-2-9 02:03
补充说明一下:现在要自动处理公文,不像过去我只认一种格式“2024年2月9日”,现在共有 5 种格式了!
* 2 ...

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-6-6 01:26 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
谢谢楼上朋友!前些天我也有上传更新版本的打算,但因精力有限、天气火热,我又爱玩游戏(最近又重新玩起 CSOL,以前玩 CODOL、NFSOL),现在有一个不成熟的版本。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-25 15:19 , Processed in 0.036679 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表