[已解决]有关于提取整理特殊文本内容的求助

qiuzhuvba

附件下载： help.rar (520 Bytes, 下载次数: 30)

2016-3-6 10:28 上传

点击文件名下载附件




要提取整理的内容。

中间间隔50行，这50行里有空格也有数字。

例如

1. 
   
2. 
   
3. 
   
4. 
   
5. 
   
6. 
   
7. 6
   
8. 
   
9. 
   
10. 
    
11. 
    
12. 
    
13. 2
    
14. 
    
15. 
    
16. 
    
17. 
    
18. 
    
19. 
    
20. 
    
21. 
    
22. 
    
23. 
    
24. 
    
25. 
    
26. 
    
27. 6
    
28. 
    
29. 
    
30. 
    
31. 0
    
32. 
    
33. 
    
34. 
    
35. 
    
36. 
    
37. 
    
38. 
    
39. 
    
40. 
    
41. 
    
42. 
    
43. 
    
44. 
    
45. 4
    
46. 
    
47. 
    
48. 
    
49. 
    

复制代码

最后提取整理的结果如下：

20160305-0001 62604
20160305-0002 63897
20160305-0003 92994
20160305-0004 37289
20160305-0005 30152
20160305-0006 31084

最佳答案

月排行榜 / 总排行榜

grf1973

2016-3-7 11:03

去掉中间断断续续的。。。

1. Sub Macro1()
   
2.     Dim arr(1 To 1000, 1 To 2), tmp
   
3.     Dim brr()
   
4.     Open ThisWorkbook.Path & "\提取特殊文本内容.txt" For Input As #1
   
5.     Do While Not EOF(1)
   
6.         m = m + 1
   
7.         ReDim Preserve brr(m)
   
8.         Line Input #1, tmp
   
9.         tmp = Trim(tmp): brr(m) = tmp
   
10.         If InStr(tmp, "-") > 0 Then
    
11.             n = n + 1
    
12.             arr(n, 1) = tmp '读入每行
    
13.         ElseIf Len(brr(m - 1)) > 0 Then
    
14.             arr(n, 2) = arr(n, 2) & tmp
    
15.         End If
    
16.     Loop
    
17.     Close #1
    
18.     If n > 0 Then Sheet1.[a1].Resize(n, 2) = arr
    
19. End Sub
    

复制代码

跳转到最佳答案楼层

baksy

附件

qiuzhuvba

baksy 发表于 2016-3-6 12:11
附件

公式的呀。。。

数据量 有点大啊，、
有8万多行的数据要整理提取呢。

ghostjiao

数字开始的格式是怎么样的？  都像这种 20160305-0001？组成规则是怎样的

中间隔得行只有空格和数字，还会有其他格式数据吗？

grf1973

1. Sub Macro1()
   
2.     Dim arr(1 To 1000, 1 To 2), tmp
   
3.     Open ThisWorkbook.Path & "\提取特殊文本内容.txt" For Input As #1
   
4.     Do While Not EOF(1)
   
5.         Line Input #1, tmp
   
6.         tmp = Trim(tmp)
   
7.         If InStr(tmp, "-") > 0 Then
   
8.             n = n + 1
   
9.             arr(n, 1) = tmp '读入每行
   
10.         Else
    
11.             arr(n, 2) = arr(n, 2) & tmp
    
12.         End If
    
13.     Loop
    
14.     Close #1
    
15.     If n > 0 Then Sheet1.[a1].Resize(n, 2) = arr
    
16. End Sub
    

复制代码

grf1973

去掉中间断断续续的。。。

1. Sub Macro1()
   
2.     Dim arr(1 To 1000, 1 To 2), tmp
   
3.     Dim brr()
   
4.     Open ThisWorkbook.Path & "\提取特殊文本内容.txt" For Input As #1
   
5.     Do While Not EOF(1)
   
6.         m = m + 1
   
7.         ReDim Preserve brr(m)
   
8.         Line Input #1, tmp
   
9.         tmp = Trim(tmp): brr(m) = tmp
   
10.         If InStr(tmp, "-") > 0 Then
    
11.             n = n + 1
    
12.             arr(n, 1) = tmp '读入每行
    
13.         ElseIf Len(brr(m - 1)) > 0 Then
    
14.             arr(n, 2) = arr(n, 2) & tmp
    
15.         End If
    
16.     Loop
    
17.     Close #1
    
18.     If n > 0 Then Sheet1.[a1].Resize(n, 2) = arr
    
19. End Sub
    

复制代码

qiuzhuvba

grf1973 发表于 2016-3-7 11:03
去掉中间断断续续的。。。

老师好。。。。发现有一个错误的地方。

多了一个0
请修正一下。。。

测试文本。 提取特殊文本内容.rar (345 Bytes, 下载次数: 6)

2016-3-7 14:56 上传

点击文件名下载附件

grf1973

我是通过判断某数上面为空，则不计入，否则计入。你的数据最后几行的“0”上有个“9”，所以计入了。

grf1973

如果要改代码，得明确规则。在我看来
9
9
0
0
2
和
9
0
并没有什么区别

qiuzhuvba

grf1973 发表于 2016-3-7 15:49
如果要改代码，得明确规则。在我看来
9
9

可以 这样不。。

例如
20160305-0010
长度为：13

判断 这长度为13的数字串 再加 后面 5行数据 就是要提取并整理的结果

如
20160305-0009       
2
1
9
6
1

整理成20160305-0009 21961


20160305-0010       
9
9
0
0
2

整理成20160305-0010 99002