ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
易厚学堂-专业的职场技能充电站 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 ExcelHome出品 - VBA代码宝免费下载 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 488|回复: 32

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

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-9-13 19:41 | 显示全部楼层 |阅读模式
        因为带着小孩子做科学实验,所以产生了很多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年前的回复,所以不太好挖坟去询问别人,而我又是一个死脑经的究极萌新,当时脑袋抽筋似的一直想搞明白,东拼西凑找代码,钻牛角尖熬夜到第二天中午十二点依然无法解决,当时是真滴头疼,觉得自己抄近路的想法真的是撞得头破血流,虽然想着好好看教程学一学,但是无奈时间紧,任务重,因此恳求各位大神能够给我一点帮助,我的具体需求如下:


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


1536838234(1).png

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

求助.zip

19.83 KB, 下载次数: 10

TA的精华主题

TA的得分主题

发表于 2018-9-13 20:37 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-13 21:01 | 显示全部楼层
chxw68 发表于 2018-9-13 20:37
结果数据排列很奇怪!

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

TA的精华主题

TA的得分主题

发表于 2018-9-13 21:04 | 显示全部楼层
Roota 发表于 2018-9-13 21:01
我后期给处理成了相对时间,比如原来的是20:32:10,20:32:20,我处理为0,10。就是用后面的时间减去 ...

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-13 21:07 | 显示全部楼层
chxw68 发表于 2018-9-13 21:04
这个能看懂,就是梯形排列挺怪的。

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

TA的精华主题

TA的得分主题

发表于 2018-9-13 21:29 | 显示全部楼层
  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
复制代码

评分

参与人数 1鲜花 +2 收起 理由
Roota + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-9-13 21:30 | 显示全部楼层
没有按阶梯排列,代码供参考吧。

求助.rar

25 KB, 下载次数: 24

TA的精华主题

TA的得分主题

发表于 2018-9-13 21:40 | 显示全部楼层
代码2稍作修改,可以排到545行,你的要求我没看懂。
11111111.jpg

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-13 21:45 | 显示全部楼层
chxw68 发表于 2018-9-13 21:30
没有按阶梯排列,代码供参考吧。

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

TA的精华主题

TA的得分主题

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

应该有不是日期的数据!

评分

参与人数 1鲜花 +2 收起 理由
Roota + 2 感谢帮助

查看全部评分

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

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2018-11-19 17:57 , Processed in 0.106852 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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