ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: ggmmlol

[Excel 程序开发] [第127期]替换特定规则范围内的字符[已总结评分]

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-11-20 14:17 | 显示全部楼层
本帖最后由 ykqrs 于 2019-11-21 15:25 编辑

复制代码

今天中午有时间又琢磨了一下,又重新看了一下答题要求,这个不让循环真是费脑,想不出来!!!!
只有笨办法,由于楼主的主体代码不让修改,而我又的确不知道Call Form_Initialize这一句是干嘛用的,所以添加了一个只为不出错误的Form_Initialize()过程,原楼层不知为何无法编辑,只能再占用一层,抱歉!
  1. Sub Form_Initialize()

  2. End Sub

  3. Private Function ReplaceRestrictive$(ByVal StrSource$)
  4.     Dim reg
  5.     Set reg = CreateObject("vbscript.regexp")
  6.     reg.Pattern = "(.*?\d)(\e)(?=\d)"
  7.     reg.Global = True
  8.     StrSource = reg.Replace(StrSource, "$1" & 2)
  9.     reg.Pattern = "(.*?\d)(\e{2})(?=\d)"
  10.     StrSource = reg.Replace(StrSource, "$1" & 22)
  11.     reg.Pattern = "(.*?\d)(\e{3})(?=\d)"
  12.     StrSource = reg.Replace(StrSource, "$1" & 222)
  13.     reg.Pattern = "(.*?\d)(\e{4})(?=\d)"
  14.     StrSource = reg.Replace(StrSource, "$1" & 2222)
  15.     '此处往下可继续。。。。。呵呵
  16.     ReplaceRestrictive = StrSource
  17. End Function
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-11-21 15:28 | 显示全部楼层
真的不想占楼,编辑完不显示。
今天从早上折腾到现在,总想一句替换没成功,只能这样了,然后,不玩了,再晚就傻了,踏踏实实坐等学习!
  1. Sub Form_Initialize()

  2. End Sub

  3. Private Function ReplaceRestrictive$(ByVal StrSource$)
  4. Dim reg
  5.     Set reg = CreateObject("vbscript.regexp")
  6.     reg.Global = True
  7.     reg.Pattern = "(\e)(?!\e*?\d)"
  8.     StrSource = StrReverse(reg.Replace(StrSource, "々 + √"))
  9.     StrSource = StrReverse(reg.Replace(StrSource, "√ + 々"))
  10.     StrSource = Replace(StrSource, "e", 2)
  11.     StrSource = Replace(StrSource, "々 + √", "e")
  12.     ReplaceRestrictive = StrSource
  13. End Function
复制代码

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-11-25 17:07 | 显示全部楼层
不会玩正则,凑个热闹,不能用循环来个仅适合案例的代码
  1. '###############下方为参赛者代码区#####################

  2. Sub Form_Initialize()
  3. End Sub
  4.    
  5. Private Function ReplaceRestrictive$(ByVal StrSource$)
  6.    Dim regx, S$, Strnew$
  7.       S = StrSource
  8.       Set regx = CreateObject("vbscript.regexp")
  9.       regx.Pattern = "([0-9])(e)([0-9])"
  10.       regx.Global = True
  11.       S = regx.Replace(S, "$12$3")
  12.       regx.Pattern = "([0-9])(e){2}([0-9])"
  13.       S = regx.Replace(S, "$122$3")
  14.       regx.Pattern = "([0-9])(e){3}([0-9])"
  15.       S = regx.Replace(S, "$1222$3")
  16.       regx.Pattern = "([0-9])(e){4}([0-9])"
  17.       S = regx.Replace(S, "$12222$3")
  18.    ReplaceRestrictive = S
  19. End Function

  20. '###############上方为参赛者代码区#####################
复制代码

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-11-25 22:44 | 显示全部楼层
蒙出了一个结果,也不知道合不合规,请指教。

运行很慢,鄙人用的是office2019家庭和学生版,可以运行的。

代码如下,其中借用了您的“通用正则替换函数”:

  1. Option Explicit
  2. '###############?·?????????????#####################
  3. Private Sub Form_Initialize()
  4.     Range("b2:b" & Cells(Rows.Count, 1).End(xlUp).Row).Value = ""
  5. End Sub
  6. Public Function REGREPLACE(ByVal text1$, ByVal pttn$, Optional ByVal strReplacer$ = " ")
  7.     With CreateObject("vbscript.regexp")
  8.         .Global = True
  9.         .Pattern = pttn
  10.         REGREPLACE = .Replace(text1, strReplacer)
  11.     End With
  12. End Function
  13. Function Autocal(Cell)
  14.     With CreateObject("Access.Application")
  15.         Autocal = .Eval(Cell)
  16.     End With
  17. End Function
  18. Private Function ReplaceRestrictive$(ByVal StrSource$)
  19.     ReplaceRestrictive = Autocal(Chr(34) & REGREPLACE(StrSource, "(\d)(e+)(?=\d)", "$1"" & string(len(""$2""),""2"") & """) & Chr(34))
  20. End Function
  21. '###############???????????????#####################
  22. Private Sub CommandButton1_Click()
  23.     Dim r&, ar(), br(), i&
  24.     r = Cells(Rows.Count, 1).End(xlUp).Row
  25.     If r < 2 Then Exit Sub
  26.     Call Form_Initialize
  27.     ar = Range("A1").Resize(r)
  28.     ReDim br(2 To r, 1 To 1)
  29.     For i = 2 To r
  30.         br(i, 1) = ReplaceRestrictive(ar(i, 1))
  31.     Next
  32.     Range("b2").Resize(r - 1) = br
  33. End Sub
复制代码

附件如下:


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

评分

4

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-12-8 16:39 | 显示全部楼层
效果做出来了,但是两个过程相互调用不知道算不算递归,正则直接替换实在搞不来

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

评分

4

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-12-9 12:05 | 显示全部楼层
本帖最后由 jsgj2023 于 2019-12-12 11:15 编辑
  1. Private Function ReplaceRestrictive$(ByVal StrSource$)
  2.     Dim RegExp As Object, sRes As String
  3.     Set RegExp = CreateObject("VbScript.RegExp")
  4.     With RegExp
  5.         .Global = True
  6.         .IgnoreCase = False
  7.         .Pattern = ""
  8.         .Pattern = "^([^\de]*e+)()|([^\de]e+)(\d)"
  9.         sRes = .Replace(StrSource, "$1$3" & vbNullChar & "$2$4")
  10.         .Pattern = "e(?=e*\d)"
  11.         sRes = .Replace(sRes, "2")
  12.         sRes = Replace(sRes, vbNullChar, "")
  13.         ReplaceRestrictive = sRes
  14.     End With
  15. End Function
复制代码

请测试,谢谢!

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-12-11 11:23 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
我以为只有我才会蒙起头来玩硬写的把戏,原来老师们无耻起来不输于我呀
我有跟 ykqrs 老师一样的困惑,一直不知道  Call Form_Initialize 这句是干嘛的怎么用…… 为此还特意的去看了看自定义函数的套路,也是没找到答案。

楼主快公布答案吧

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-12-11 11:25 | 显示全部楼层
参与本期竞赛的截止日期已到,现在开贴,开放阅读权限。

先贴上我的参考答案。总结点评的内容稍后。

  1. Option Explicit
  2. '###############下方为参赛者代码区#####################
  3. Private reg As Object
  4. Private Sub Form_Initialize()
  5.     Set reg = CreateObject("VBScript.RegExp")
  6.     reg.Global = True
  7.     reg.Pattern = "((?:(?:[^\de]|^)e+|[\d\D]*?)*)(e(?=e*\d)|$)" '式1
  8. '    reg.Pattern = "([\d\D]*?(?:(?:[^\de]|^)e+[\d\D]*?)*)(e(?=e*\d)|$)" '式2
  9. '    reg.Pattern = "((?:(?:[^\de]|^)e+[\d\D]*?)*)(e(?=e*\d)|$)" '式3
  10. '    reg.Pattern = "((?:e+(?![\de])|(?:[^\de]|^)e+|[^e])*)(e|$)" '式4
  11. '    reg.Pattern = "((?:e+(?![\de])|(?:[^\de]|^)e+|[^e])*)e?" '式5
  12. '    reg.Pattern = "((?:e+(?![\de])|(?:[^\de]|^)e+|[^e])*).?" '式6
  13. '    reg.Pattern = "((?:e+(?:[^\de]|$)|(?:[^\de]|^)e+|[^e])*)e?" '式7
  14. '    reg.Pattern = "((?:e+(?:[^\de]|$)|(?:[^\de]|^)e+|[^e])*).?" '式8
  15. End Sub

  16. Private Function ReplaceRestrictive$(ByVal StrSource$)

  17.     ReplaceRestrictive = Left(reg.Replace(StrSource, "$12"), Len(StrSource)) '本题特解
  18.     '通用方法:
  19. '   If StrSource = "" Then Exit Function
  20. '    StrSource = reg.Replace(StrSource, "$12")
  21. '    ReplaceRestrictive = Left(StrSource, Len(StrSource) - 2) '2为本例源字符串替换后增加的固定字符个数
  22. End Function

  23. '###############上方为参赛者代码区#####################
复制代码


评分

3

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-12-11 15:15 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
楼主牛哇,这种字符串的分拆思路也是没谁了:






字符串:        deegr12345ee56789fgh234eee6789kse213eee123                                                                                       
                                                                                               
正则表达式:        ((?:(?:[^\de]|^)e+|[\d\D]*?)*)(e(?=e*\d)|$)                                                                                       
                                                                                               
匹配项        组1($1)        组2($2)                                                                               
deegr12345e        deegr12345        e                                                                               
e                e                                                                               
56789fgh234e        56789fgh234        e                                                                               
e                e                                                                               
e                e                                                                               
6789kse213e        6789kse213        e                                                                               
e                e                                                                               
e                e                                                                               
123        123                                                                                       



令人大开眼界!

顺便提一句,我那个蒙的如果没有安装access组件的话是不能运行的,我现在才发现,哈哈。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

TA的精华主题

TA的得分主题

发表于 2019-12-11 15:56 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
确实强大。
我也想过把每个e单独匹配出来替换,但是正则表达式写不出来。而且,看了楼主的表达式才知道,原来捕获分组和零宽断言之类的竟然允许嵌套着用,哎!我煮熟的技术分。。。。。。。

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

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

GMT+8, 2024-4-20 05:25 , Processed in 0.054391 second(s), 19 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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