Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 1786|回复: 8

[已解决]如何提取这种很难的格式的TXT文档的内容?谢谢wanao2008老师和grf1973老师

[复制链接]
发表于 2016-7-7 19:09 | 显示全部楼层 |阅读模式
本帖最后由 lhj323323 于 2016-7-7 23:36 编辑

老师:

本需求是
从同路径指定文件夹内提取全部TXT文档的指定内容
但是
这些文档的格式虽然是统一的,但却很怪,用Split("字符串","分割符"),都不知该以什么作为分割符(当然,是按我的水平,做不到)

请老师帮忙看看,该怎么实现这种需求。先谢谢了。
这种格式.rar (19.39 KB, 下载次数: 9)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2016-7-7 21:13 | 显示全部楼层    本楼为最佳答案   
本帖最后由 wanao2008 于 2016-7-7 21:15 编辑

终于给你弄好了,我是用正则来提取数据的,请测试
  1. Sub wanao()
  2.     Dim txtLine, OpenE As Integer, Lx As Integer
  3.     Dim FileObj As Object, TextObj As Object, FilePath As Object, OpenText As Object
  4.     Dim MyStr As String, tL As Integer, x As Integer
  5.     Dim regEX As Object, mc
  6.     '使用正则提取数据
  7.     Set regEX = CreateObject("VBSCRIPT.REGEXP")
  8.     With regEX
  9.         .Global = True
  10.         .IgnoreCase = True
  11.         .Pattern = "\S+"
  12.     End With
  13.     Set FileObj = CreateObject("Scripting.FileSystemObject")
  14.     Set FilePath = FileObj.getfolder(ThisWorkbook.Path & "\数据源")
  15.     '用SHEET1的数据给SHEET2表制作个表头,如果你提前做好了,可删除下面这句
  16.     Sheet1.Range("I9:M9").Copy Sheet2.Range("A1:E1")
  17.     For Each OpenText In FilePath.Files
  18.         OpenE = 0
  19.         Lx = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
  20.         '制作标题行
  21.         If Lx > 2 Then Sheet2.Range("A1:E1").Copy Sheet2.Range("A" & Lx + 1 & ":E" & Lx + 1): Lx = Lx + 1
  22.         Set TextObj = FileObj.OpenTextFile(OpenText, 1, True)
  23.         For x = 1 To 50
  24.             tt = TextObj.readline
  25.             If Left(tt, 4) = "────" Then
  26.                 If OpenE = 1 Then Exit For
  27.                 OpenE = 1
  28.                 tt = TextObj.readline
  29.             End If
  30.             If OpenE = 1 Then
  31.                 Set mc = regEX.Execute(tt)
  32.                 If mc.Count = 5 Then
  33.                     Lx = Lx + 1
  34.                     For i = 0 To 4
  35.                         Sheet2.Cells(Lx, i + 1) = mc(i)
  36.                     Next
  37.                 ElseIf mc.Count = 1 Then
  38.                     Sheet2.Cells(Lx, 1) = Sheet2.Cells(Lx, 1) & mc(0)
  39.                 ElseIf mc.Count = 6 Then
  40.                     Lx = Lx + 1
  41.                     Sheet2.Cells(Lx, 1) = mc(0)
  42.                     Sheet2.Cells(Lx, 2) = mc(1)
  43.                     Sheet2.Cells(Lx, 3) = mc(2) & " " & mc(3)
  44.                     Sheet2.Cells(Lx, 4) = mc(4)
  45.                     Sheet2.Cells(Lx, 5) = mc(5)
  46.                 ElseIf mc.Count = 4 Then
  47.                     Lx = Lx + 1
  48.                     For i = 0 To 3
  49.                         Sheet2.Cells(Lx, i + 2) = mc(i)
  50.                     Next
  51.                 End If
  52.             End If
  53.         Next
  54.     Next
  55.     Set TextObj = Nothing
  56.     Set FileObj = Nothing
  57. End Sub
复制代码
回复

使用道具 举报

发表于 2016-7-7 22:30 | 显示全部楼层
格式比较乱。。。。

这种格式.rar

31.35 KB, 下载次数: 7

回复

使用道具 举报

 楼主| 发表于 2016-7-7 22:45 | 显示全部楼层
grf1973 发表于 2016-7-7 22:30
格式比较乱。。。。

谢谢grf1973老师

的确不好处理

运行您写的语句后,如下图,标红处,就是乱的。
快照1.png
回复

使用道具 举报

 楼主| 发表于 2016-7-7 22:46 | 显示全部楼层
wanao2008 发表于 2016-7-7 21:13
终于给你弄好了,我是用正则来提取数据的,请测试

谢谢wanao2008老师!

正则太神奇了。

正则与字典是否处于同一级别?
我不懂正则,问偏了,请别介意。呵呵
回复

使用道具 举报

 楼主| 发表于 2016-7-7 23:02 | 显示全部楼层
wanao2008 发表于 2016-7-7 21:13
终于给你弄好了,我是用正则来提取数据的,请测试



老师:

我问个较蠢的问题

你所用的正则,和三楼grf1973老师用的方法,是平行关系吗?

三楼grf1973老师用的是什么?
在听到正则之前,我一直以为这就是叫VBA,现在看来,可能从一开始,就把概念搞错了。
回复

使用道具 举报

 楼主| 发表于 2016-7-7 23:35 | 显示全部楼层
wanao2008 发表于 2016-7-7 21:13
终于给你弄好了,我是用正则来提取数据的,请测试

wanao2008老师

别说【请】字,说得我都不好意思了,谢谢你。
回复

使用道具 举报

发表于 2016-7-8 07:14 | 显示全部楼层
lhj323323 发表于 2016-7-7 23:02
老师:

我问个较蠢的问题

有时间我看看 grf1973老师 的方法


回复

使用道具 举报

 楼主| 发表于 2016-7-8 09:30 | 显示全部楼层
wanao2008 发表于 2016-7-8 07:14
有时间我看看 grf1973老师 的方法

那顺便看看,我在一楼上传的附件,用的是什么方法,呵呵
回复

使用道具 举报

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

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 14:10 , Processed in 1.228172 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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