萌新吐血求助——批量txt导入excel并选取特定数据分列排序

Roota

chxw68 发表于 2018-9-13 21:50
应该有不是日期的数据！

老师您好，我找到问题的原因了，txt数据文件夹有100+是以901-F-01-a，901-F-01-b等序列进行命名的，这种命名方式是小孩自定义的，意思是9月1号的F-01号传感器的a位置及b位置，这样的话我是不是得修改代码关于日期的定义呢？

chxw68

Roota 发表于 2018-9-13 22:01
老师您好，我找到问题的原因了，txt数据文件夹有100+是以901-F-01-a，901-F-01-b等序列进行命名的，这种 ...

你上传一个TXT文件上来。

Roota

老师您好，文件格式大致是这样的，这位小朋友测的位置比较多，所以一天的数据量也很多

onlycxb

1. Sub test()
   
2.     Dim ColumnIndex As Integer, RowIndex As Integer
   
3.     Dim arr, brr, Crr, mypath$, myname$, reg As New RegExp
   
4. 
   
5.     With reg
   
6.         .Global = False
   
7.         .Pattern = "^[a-zA-Z]+\s+(\d{4}-\d{2}-\d{2}\s+\d{2}:\d{2}:\d{2})\s+\|\s+[\d\.]+\s+\%\s+([\d\.]+)\s+C\s+$"
   
8.     End With
   
9.     mypath = ThisWorkbook.Path & ""
   
10.     myname = Dir(mypath & "*.txt")
    
11.     With Worksheets("sheet1")
    
12.         .Cells.Clear
    
13.     End With
    
14. 
    
15.     ColumnIndex = 1
    
16.     RowIndex = 1
    
17. 
    
18.     Do While myname <> ""
    
19.         Open mypath & myname For Input As #1
    
20.         arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    
21.         Close #1
    
22.         ReDim brr(0 To UBound(arr) - 1, 1 To 2)
    
23. 
    
24.         ColumnIndex = ColumnIndex + 1
    
25.         For i = 0 To UBound(arr) - 1
    
26. 
    
27.             ss = Trim(arr(i))
    
28.             If Len(ss) > 0 Then
    
29.                 Set mh = reg.Execute(ss)
    
30.                 If mh.Count > 0 Then
    
31.                     brr(i, 1) = mh(0).SubMatches(0)
    
32.                     brr(i, 2) = Val(mh(0).SubMatches(1))
    
33.                 End If
    
34.             End If
    
35.         Next
    
36.         rq = CDate(brr(0, 1))
    
37.         For i = 0 To UBound(brr)
    
38.             brr(i, 1) = Round((CDate(brr(i, 1)) - rq) * 24 * 60 * 60, 0)
    
39.         Next
    
40.         With Worksheets("sheet1")
    
41.             .Cells(RowIndex, 1) = Split(myname, ".")(0)
    
42.             .Cells(1, ColumnIndex) = Split(myname, ".")(0)
    
43.             .Cells(RowIndex + 1, 1).Resize(UBound(brr) + 1, 1) = Application.Index(brr, , 1)
    
44.             .Cells(RowIndex + 1, ColumnIndex).Resize(UBound(brr) + 1, 1) = Application.Index(brr, , 2)
    
45.             RowIndex = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    
46.         End With
    
47. 
    
48.         myname = Dir
    
49.     Loop
    
50. End Sub
    

复制代码

Roota

chxw68 发表于 2018-9-13 22:03
你上传一个TXT文件上来。

老师您好，我好像找到问题了，应该是有一些txt数据中日期上乱的，传感器没有重新设置时间，例如某几个txt中日期格式为2000-00-00，我将其全部替换为2018-09-01之后，您的代码就可以正常运行了

onlycxb

1. Sub test()
   
2.     Dim ColumnIndex As Integer, RowIndex As Integer
   
3.     Dim arr, brr, Crr, mypath$, myname$, reg As New RegExp
   
4.     On Error Resume Next
   
5.     With reg
   
6.     End With
   
7.     mypath = ThisWorkbook.Path & ""
   
8.     myname = Dir(mypath & "*.txt")
   
9.     With Worksheets("sheet1")
   
10.         .Cells.Clear
    
11.     End With
    
12. 
    
13.     ColumnIndex = 1
    
14.     RowIndex = 1
    
15. 
    
16.     Do While myname <> ""
    
17. 
    
18.         reg.Global = False
    
19.         reg.Pattern = "^[a-zA-Z]+\s+(\d{4}-\d{2}-\d{2}\s+\d{2}:\d{2}:\d{2})\s+\|\s+[\d\.]+\s+\%\s+([\d\.]+)\s+C\s+$"
    
20. 
    
21.         Open mypath & myname For Input As #1
    
22.         arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    
23.         Close #1
    
24.         ReDim brr(0 To UBound(arr) - 1, 1 To 2)
    
25. 
    
26.         ColumnIndex = ColumnIndex + 1
    
27.         For i = 0 To UBound(arr) - 1
    
28. 
    
29.             ss = Trim(arr(i))
    
30.             If Len(ss) > 0 Then
    
31.                 Set mh = reg.Execute(ss)
    
32.                 If mh.Count > 0 Then
    
33.                     brr(i, 1) = mh(0).SubMatches(0)
    
34.                     brr(i, 2) = Val(mh(0).SubMatches(1))
    
35.                 End If
    
36.             End If
    
37.         Next
    
38. 
    
39.         For i = 0 To UBound(brr)
    
40.             reg.Global = True
    
41.             reg.Pattern = "-00"
    
42.             brr(i, 1) = reg.Replace(brr(i, 1), "")
    
43.             rq = CDate(brr(0, 1))
    
44.             brr(i, 1) = Round((CDate(brr(i, 1)) - rq) * 24 * 60 * 60, 0)
    
45.         Next
    
46.         With Worksheets("sheet1")
    
47.             .Cells(RowIndex, 1) = Split(myname, ".")(0)
    
48.             .Cells(1, ColumnIndex) = Split(myname, ".")(0)
    
49.             .Cells(RowIndex + 1, 1).Resize(UBound(brr) + 1, 1) = Application.Index(brr, , 1)
    
50.             .Cells(RowIndex + 1, ColumnIndex).Resize(UBound(brr) + 1, 1) = Application.Index(brr, , 2)
    
51.             RowIndex = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    
52.         End With
    
53. 
    
54.         myname = Dir
    
55.     Loop
    
56. End Sub
    

复制代码

onlycxb

901-温度数据.zip (394.97 KB, 下载次数: 15)

2018-9-14 06:23 上传

点击文件名下载附件

chxw68

Roota 发表于 2018-9-13 22:40
老师您好，我好像找到问题了，应该是有一些txt数据中日期上乱的，传感器没有重新设置时间，例如某几个txt ...

就是这个问题！2000-00-00不是合法日期，就无法进行日期计算，所以代码就出错。

zopey

加个语句
     on error resume next

chxw68

zopey 发表于 2018-9-14 08:45
加个语句
     on error resume next

这个是麻醉药，止痛但不治病。