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

Roota

        因为带着小孩子做科学实验，所以产生了很多txt格式记录的温湿度数据，200+的txt，前100我都是一个个导入然后分列，选择不导XX列冗余数据，再一列列把数据复制粘贴成需要的格式，耗费了极大的精力和时间，于是在上周的一个晚上，我翻遍了所有EXCELHOME论坛中带txt批量导入以及分列的帖子，找到了一些凑合能用的代码，例如代码1：Sub DAORU()Dim s() As String, f As String, i As Long, b() As Byte
With Sheet1
  .Cells.Clear
    f = Dir(ThisWorkbook.Path & "\*.TXT")
    While f > ""
        Open ThisWorkbook.Path & "" & f For Input As #1
        s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
        Close #1
        .[A1].Offset(, i) = f
        .[A2].Offset(, i).Resize(UBound(s) + 1) = WorksheetFunction.Transpose(s)
         i = i + 1
         f = Dir()
     Wend
     .Rows(1).Replace What:=".txt", Replacement:="", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    With .Range("A1").CurrentRegion
        .Sort key1:=Sheet1.Cells(1), order1:=xlAscending, Orientation:=xlSortRows
    End With
    .Activate
End With
MsgBox "OK"
End Sub
代码2：Sub cc()
      Dim Str As String, s, i%
     Str = Dir(ThisWorkbook.Path & "/*.txt")
    Application.DisplayAlerts = False
    [a:h].ClearContents
     Do While Str <> ""
        Open ThisWorkbook.Path & "\*.txt" & Str For Input As #1
        s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
        Close #1
       For i = 0 To UBound(s)
        If s(i) <> "" Then s(i) = Str & " " & s(i)
         Next
      [a65536].End(3)(2).Resize(UBound(s) + 1) = WorksheetFunction.Transpose(s)
     Str = Dir()
     Loop
     [a:a].TextToColumns [a2:h2], OtherChar:=" "
    Application.DisplayAlerts = True
End Sub
其中代码2应该能满足我的绝大部分需求，但是总是遇到503，文件无法找到的错误，或者下标界限超出，代码时而能反应，时而没有作用，由于帖子都是4至5年前的回复，所以不太好挖坟去询问别人，而我又是一个死脑经的究极萌新，当时脑袋抽筋似的一直想搞明白，东拼西凑找代码，钻牛角尖熬夜到第二天中午十二点依然无法解决，当时是真滴头疼，觉得自己抄近路的想法真的是撞得头破血流，虽然想着好好看教程学一学，但是无奈时间紧，任务重，因此恳求各位大神能够给我一点帮助，我的具体需求如下：



需要将100+txt文件中的时间列和温度列导入一个SHEET，首列以文件名命名，分别记录各个txt文件中的时间序列（完成的excel中是我后期处理过的相对时间），之后每列呈阶梯状记录各个txt文件的对应温度序序列。




恳求大家的帮助，如果能优化代码2，可以节省我后期比较大的工作量；如果能完成最终格式要求的话，真是不胜感激，如果您坐标在北京的话，一定要答应我请您吃海底捞！！！

chxw68

结果数据排列很奇怪！

Roota

chxw68 发表于 2018-9-13 20:37
结果数据排列很奇怪！

我后期给处理成了相对时间，比如原来的是20：32：10，20：32：20，我处理为0，10。就是用后面的时间减去第一个时间

chxw68

Roota 发表于 2018-9-13 21:01
我后期给处理成了相对时间，比如原来的是20：32：10，20：32：20，我处理为0，10。就是用后面的时间减去 ...

这个能看懂，就是梯形排列挺怪的。

Roota

chxw68 发表于 2018-9-13 21:04
这个能看懂，就是梯形排列挺怪的。

对，这个是为了后期作图方便，全选之后，时间数据和温度数据是一一对应的，这样就可以插入图表，可以方便给小朋友最直观的反馈，让他们知道自己测的数据反映的是一个怎样的趋势，全都是竖着一列一列也没有问题，但是我现在都没办法把时间和温度数据一一对应导入进去了

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim mypath$, myname$
   
5.   Dim reg As New RegExp
   
6.   With reg
   
7.     .Global = False
   
8.     .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+$"
   
9.   End With
   
10.   mypath = ThisWorkbook.Path & ""
    
11.   myname = Dir(mypath & "*.txt")
    
12.   With Worksheets("sheet1")
    
13.     .Cells.Clear
    
14.   End With
    
15.   n = 1
    
16.   Do While myname <> ""
    
17.     Open mypath & myname For Input As #1
    
18.     arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    
19.     Close #1
    
20.     ReDim brr(0 To UBound(arr) - 1, 1 To 2)
    
21.     m = 0
    
22.     For i = 0 To UBound(arr) - 1
    
23.       ss = Trim(arr(i))
    
24.       If Len(ss) > 0 Then
    
25.         Set mh = reg.Execute(ss)
    
26.         If mh.Count > 0 Then
    
27.           brr(i, 1) = mh(0).SubMatches(0)
    
28.           brr(i, 2) = Val(mh(0).SubMatches(1))
    
29.         End If
    
30.       End If
    
31.     Next
    
32.     rq = CDate(brr(0, 1))
    
33.     For i = 0 To UBound(brr)
    
34.       brr(i, 1) = Round((CDate(brr(i, 1)) - rq) * 24 * 60 * 60, 0)
    
35.     Next
    
36.     With Worksheets("sheet1")
    
37.       .Cells(1, n) = Split(myname, ".")(0)
    
38.       .Cells(1, n + 1) = Split(myname, ".")(0)
    
39.       .Cells(2, n).Resize(UBound(brr) + 1, 2) = brr
    
40.     End With
    
41.     n = n + 2
    
42.     myname = Dir
    
43.   Loop
    
44. End Sub
    

复制代码

chxw68

没有按阶梯排列，代码供参考吧。

719404338

代码2稍作修改，可以排到545行，你的要求我没看懂。

Roota

chxw68 发表于 2018-9-13 21:30
没有按阶梯排列，代码供参考吧。

老师您好，我把这个.xlsm文件复制到我含56个txt的文件夹中后，点击按钮运行，得到了示例的文件，但是拖到150+的txt文件夹中后，出现“运行时错误，类型不匹配‘13’，类型不匹配，调试之后显示 rq = CDate(brr(0, 1))这个语句上黄颜色的，我现在在排查150+的txt文件是否有不规整的数据乱码

chxw68

Roota 发表于 2018-9-13 21:45
老师您好，我把这个.xlsm文件复制到我含56个txt的文件夹中后，点击按钮运行，得到了示例的文件，但是拖到 ...

应该有不是日期的数据！