超大批量提取txt指定数据到Excel指定列

荔枝jjee

各位大神，我有300多个几万行的txt数据怎么选择性的提取到Excel中呢？我取了一小部分数据麻烦各位大神帮我编个程序，附件有要求的效果。急求，跪谢

xulubang

公式没这么强的功能！

liu-aguang

1. Sub test()
   
2.     Dim fso, fp, reg, mh, arr, brr, f, strf, col%, str1$, firstv$, n&, k%, u%
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     Set fp = fso.getfolder(ThisWorkbook.Path)
   
5.     Set reg = CreateObject("vbscript.regexp")
   
6.     reg.Pattern = "\d+(?:\.\d+)?(?=\r)"
   
7.     reg.Global = True
   
8.     col = Application.Round(fp.Files.Count / 2, 0)
   
9.     ReDim arr(1 To col, 1 To 1)
   
10.     ReDim brr(1 To col, 1 To 1)
    
11.     For Each f In fp.Files
    
12.         If fso.getextensionname(f) = "txt" Then
    
13.             Set strf = fso.opentextfile(f)
    
14.             str1 = strf.ReadAll
    
15.             n = strf.Line
    
16.             firstv = Split(fso.getfilename(f), ".")(0)
    
17.             strf.Close
    
18.             Set mh = reg.Execute(str1)
    
19.             If firstv Mod 2 = 0 Then
    
20.                 k = k + 1
    
21.                 If UBound(arr, 2) < n Then ReDim Preserve arr(1 To col, 1 To n)
    
22.                 arr(k, 1) = firstv
    
23.                 For i = 0 To mh.Count - 1
    
24.                     arr(k, i + 2) = mh(i)
    
25.                 Next
    
26.             Else
    
27.                 u = u + 1
    
28.                 If UBound(brr, 2) < n Then ReDim Preserve brr(1 To col, 1 To n)
    
29.                 brr(u, 1) = firstv
    
30.                 For i = 0 To mh.Count - 1
    
31.                     brr(u, i + 2) = mh(i)
    
32.                 Next
    
33.             End If
    
34.         End If
    
35.     Next
    
36.     Set reg = Nothing
    
37.     Set fso = Nothing
    
38.     Sheets("sheet1").Range("a2").Resize(UBound(arr, 2), UBound(arr)) = Application.Transpose(arr)
    
39.     Sheets("sheet2").Range("a2").Resize(UBound(brr, 2), UBound(brr)) = Application.Transpose(brr)
    
40. End Sub
    

复制代码

liu-aguang

偶数在表1,奇数在表2:

荔枝jjee

C:\Users\Administrator\Desktop  ？？

荔枝jjee

liu-aguang 发表于 2014-10-14 22:47

非常感谢，但是为什么无效运行呢？

荔枝jjee

liu-aguang 发表于 2014-10-14 22:51
偶数在表1,奇数在表2:

非常感谢你，但是我把它应用到30多个txt时，提取的数据有误，可以加你的qq吗？

荔枝jjee

荔枝jjee 发表于 2014-10-14 23:04
非常感谢，但是为什么无效运行呢？

ok了，O(∩_∩)O~

荔枝jjee

运用到多个txt时，数据不对了，是格式的问题吗？

liu-aguang

荔枝jjee 发表于 2014-10-14 23:14
运用到多个txt时，数据不对了，是格式的问题吗？

代码设计的是提取文本中最一列数据,如果数据不在最后列要修改代码.