ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

请问如何在一篇文档里提取如图所示的指定格式的多条字符串

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-7-17 23:36 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
请问如何在一篇文档里提取如图所示的指定格式的多条字符串,并汇总到一个新的文本文档中?
如,文档内容如下:
xxxhttp://xxxx.com/xxxx/xxxx/aaaa.mp4xxxxxxx
xxx"http:// xxxx.com/xxxx/xxxx/aaaa.mp3"xxxx
xxxx"http://xxxx.com/xaxx/bb4c8f7db0214fc9b547817116743170/a0aa.jpg"xxxxxx
xxxx"http://xxxx.com/xsxx/68e3d38315d846ae82ee07310521111e/a1aa.jpg"xxxxxx
xxxx"http://xxxx.com/xdxx/3dac9c7ea4c342c795ff017e176e6b16/a3aa.jpg"xxxxxx
xxccxcxc“”cdf
cxcxcx“http://xxxx.com/xsxx/68e3d38315d846ae82ee07310521111e/a1aa.jpeg”xx
cxcacssd“”x
cacscs“"xxxxxx
casd“http://xxxx.com/xdxx/3dac9c7ea4c342c795ff017e176e6b16/xfh app.mp4"xxxxxx
casd“http://xxxx.com/xdxx/06e49fb4a5a44324a9c38a1b36f8ccbe/音频2 app.mp4"xxxxxx
add“http://xxxx.com/xdxx/a835e9605903453c98cc7995408c3a0b/音频1 dfpp.mp3"xxxxxx aedwf“http://xxxx.com/xdxx/31038bed33d2439c85e64512ee9b2ea7/yrubbp.mp3”xxxxxxxx
xxxxxxxx

我需要从这个文档中提取以下内容并保存在一个新的文本文档中
http://xxxx.com/xaxx/bb4c8f7db0214fc9b547817116743170/a0aa.jpg
http://xxxx.com/xsxx/68e3d38315d846ae82ee07310521111e/a1aa.jpeg
http://xxxx.com/xsxx/5fb90a7b8eb04557895ca7eaa53d4b33/a1aa.png
http://xxxx.com/xsxx/6a77454a2906415683aa6760d3dd1829/a1aa.gif
http://xxxx.com/xdxx/3dac9c7ea4c342c795ff017e176e6b16/xfh app.mp4
http://xxxx.com/xdxx/06e49fb4a5a44324a9c38a1b36f8ccbe/音频2 app.mp4
http://xxxx.com/xdxx/a835e9605903453c98cc7995408c3a0b/音频1 dfpp.mp3
http://xxxx.com/xdxx/31038bed33d2439c85e64512ee9b2ea7/yrubbp.mp3


new.rar

11.49 KB, 下载次数: 6

TA的精华主题

TA的得分主题

发表于 2017-7-18 00:36 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 duquancai 于 2017-7-18 00:42 编辑

》》》》》》》》》》》》》》》》》》》》
SWXTKUZZUY@BNG8$G{OR28N.png
~]`)6)%5MKS3~$U2YO@)ZPY.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-7-18 02:26 | 显示全部楼层
duquancai 发表于 2017-7-18 00:36
》》》》》》》》》》》》》》》》》》》》

大神,我抄了你给我的代码,运行时报错

Sub 提取_WordVBA()
  s = Replace(ActiveDocument.Content.Text, vbCr, "\r")
  Set D = CreateObject("htmlfile"): Set W = D.parentWindow
  W.execScript "function f(s,r){var sr=s.match(r).join('\r\n');return function(){return(sr)}}"
  Open ThisDocument.Path & "\提取网址.txt" For Output As #1
  Print #1, W.eval("a=f('" & s & "',/http[::][^\r""]+\.(?:(?:(?:(?:jpe?|pn)g)|gif)|mp[34])/g);a()")
   Close #1
End Sub

TA的精华主题

TA的得分主题

发表于 2017-7-18 07:47 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-7-19 02:21 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-7-19 09:42 | 显示全部楼层
酿雪 发表于 2017-7-19 02:21
多谢,我WORD换个版本再试试

Sub 提取_WordVBA()
    s = Replace(ActiveDocument.Content.Text, vbCr, "\r")
    r = Array("jpeg", "jpg", "png", "gif", "mp3", "mp4")
    Set D = CreateObject("htmlfile"): Set W = D.parentWindow
    W.execScript "function f(s,r){var sr=s.match(r).join('\r\n');return function(){return(sr)}}"
    For i = 0 To UBound(r)
        srt = srt & W.eval("a=f('" & s & "',/http[::][^\r""]+\." & r(i) & "/g);a()") & vbCrLf
        W.execScript "a=null"
    Next
    Open ThisDocument.Path & "\提取.txt" For Output As #1
    Print #1, srt
    Close #1
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-9-22 23:48 | 显示全部楼层
duquancai 发表于 2017-7-19 09:42
Sub 提取_WordVBA()
    s = Replace(ActiveDocument.Content.Text, vbCr, "\r")
    r = Array("jpeg" ...

十分感谢!!!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 16:38 , Processed in 0.051435 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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