ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 7918|回复: 12

[求助] 【批量提取】txt文件【特定位置】数据至excel

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-3-14 00:03 | 显示全部楼层 |阅读模式
小弟刚开始接触vba,恳请论坛老师不吝指导:1.附件RawData文件夹下是要提取的txt文件,数量可多到数万个;
2.附件Template是依次提取RawData下txt文件中开头部分统计信息的excel文档。
多谢了!

DataExtract.rar

1.25 MB, 下载次数: 112

TA的精华主题

TA的得分主题

发表于 2017-3-14 07:50 | 显示全部楼层
Sub 按钮1_Click()
    Application.ScreenUpdating = False
    a = 2
    For Each f In CreateObject("scripting.filesystemobject").getfolder(ThisWorkbook.Path & "\RawData").Files
        Open f For Input As #1
        While Not EOF(1)
            Line Input #1, str1
            If InStr(str1, ";Logged:") > 0 Then
                Cells(a, 1).Resize(1, 2) = Split(Split(str1, "Logged:")(1), " at ")
            Else
                If Left(str1, 5) = ";Min:" Then
                    Cells(a, 3) = Split(Split(str1, ";Min:")(1), "mJ")(0)
                Else
                    If Left(str1, 5) = ";Max:" Then
                        Cells(a, 4) = Split(Split(str1, ";Max:")(1), "mJ")(0)
                    Else
                        If InStr(str1, ";Average:") > 0 Then
                            Cells(a, 5) = Split(Split(str1, ";Average:")(1), "mJ")(0)
                        Else
                            If InStr(str1, ";Std.Dev.:") > 0 Then
                                Cells(a, 6) = Split(Split(str1, ";Std.Dev.:")(1), "mJ")(0)
                            Else
                                If InStr(str1, ";Overrange:") > 0 Then
                                    Cells(a, 7) = Split(str1, ";Overrange:")(1)
                                Else
                                    If InStr(str1, ";Total Pulses:") > 0 Then
                                        Cells(a, 8) = Split(str1, ";Total Pulses:")(1)
                                        a = a + 1
                                        GoTo l1
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        Wend
l1:
        Close #1
        Next f
    Application.ScreenUpdating = True
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2017-3-14 07:51 | 显示全部楼层
附件 内容供参考吧。。。

DataExtract.zip

1.22 MB, 下载次数: 235

TA的精华主题

TA的得分主题

发表于 2017-3-14 11:51 | 显示全部楼层
代码竟然发不出来,看附件吧

DataExtract.rar

1.26 MB, 下载次数: 210

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-14 14:28 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
liulang0808 发表于 2017-3-14 07:51
附件 内容供参考吧。。。

感谢大神!还有小问题 就是我给的txt文档名称只到_05.txt 如果到_100.txt 其文件读取顺序就错排至_11.txt后 而非_99.txt后 最多能有1000000个txt 怎么办?

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-14 14:29 来自手机 | 显示全部楼层
kldxlb 发表于 2017-3-14 11:51
代码竟然发不出来,看附件吧

感谢大神!还有小问题 就是我给的txt文档名称只到_05.txt 如果到_100.txt 其文件读取顺序就错排至_11.txt后 而非_99.txt后 最多能有1000000个txt 怎么办?

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-14 14:31 来自手机 | 显示全部楼层
kldxlb 发表于 2017-3-14 11:51
代码竟然发不出来,看附件吧

感谢大神!还有小问题 就是我给的txt文档名称只到_05.txt 如果到_100.txt 其文件读取顺序就错排至_11.txt后 而非_99.txt后 最多能有1000000个txt 怎么办?

TA的精华主题

TA的得分主题

发表于 2017-3-14 14:47 | 显示全部楼层
bigear86 发表于 2017-3-14 14:31
感谢大神!还有小问题 就是我给的txt文档名称只到_05.txt 如果到_100.txt 其文件读取顺序就错排至_11.txt ...

你这个还要排序?

TA的精华主题

TA的得分主题

发表于 2017-3-14 16:32 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
bigear86 发表于 2017-3-14 14:28
感谢大神!还有小问题 就是我给的txt文档名称只到_05.txt 如果到_100.txt 其文件读取顺序就错排至_11.txt ...

对啊,按照文本顺序来的
不然把文件名读进excel里,读取完成后再处理吧

TA的精华主题

TA的得分主题

发表于 2018-12-30 22:22 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 bbcvoc 于 2018-12-30 22:25 编辑
kldxlb 发表于 2017-3-14 11:51
代码竟然发不出来,看附件吧

不错啊!!!
大神能否帮我解决一下类似的问题?   http://club.excelhome.net/thread-1454323-1-1.html

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

本版积分规则

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

GMT+8, 2024-11-17 01:34 , Processed in 0.035997 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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