跪求TXT转EXCEL VBA 代码！

injureboy · 发表于 2011-8-5 15:45

想要从批量TXT转到EXCEL文件中。并按要求做归总得动作。
A文件是TXT文本文件。B文件是想要的格式。
希望有人能教我怎么弄。本人愿意奉上200RMB。

蓝桥玄霜 · 发表于 2011-8-5 16:14

你的文件不是txt文本？
不需要化钱的。

injureboy · 发表于 2011-8-5 16:44

是lsr的格式。应该和文本格式差不多吧！！！

Zamyi · 发表于 2011-8-5 16:53

lsr格式没问题，只是数据对应有怎样的规律？英文标题看起来吃力。

injureboy · 发表于 2011-8-8 08:10

应该还好吧。都是有一一对应的啊。只是从LSR的文档里面拷贝到excel里面而已啊！

leo2011 · 发表于 2011-8-8 13:03

如果有规律，就好做的哦。

injureboy · 发表于 2011-8-8 15:52

是有规律的啊！B文件里的项目都是固定A文件里的。都是有规律的数据！拜托了。这个问题一直困扰我了很长时间了！

kevinchengcw · 发表于 2011-8-8 15:59

这种数据不知道是什么系统导出来的，以前帮别人弄过一次类似的，很麻烦的，不过制作好一个转换程序就好办了，楼主这个格式固定还是挺好弄的。

fabregasonline · 发表于 2011-8-8 16:07

不好意思。。。让你白跪了。。。不知道的说

zhaogang1960 · 发表于 2011-8-8 16:31

原帖由 injureboy 于 2011-8-8 08:10 发表
应该还好吧。都是有一一对应的啊。只是从LSR的文档里面拷贝到excel里面而已啊！

文本文件打开后就是一列（A列）数据，楼主可以根据附件中第二个工作表数据所在位置自己填写：
Sub Macro1()
Dim MyFile, arr, brr(1 To 60000, 1 To 47), i&, m&
ChDrive Split(ThisWorkbook.Path, ":")(0)
ChDir ThisWorkbook.Path
MyFile = Application.GetOpenFilename(FileFilter:="文本文件 (*.lsr),*.lsr", Title:="选择文本文件", MultiSelect:=True)
If TypeName(MyFile) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
For i = 1 To UBound(MyFile)
      Workbooks.OpenText (MyFile(i))
      With ActiveWorkbook
         arr = .Sheets(1).UsedRange
         .Close False
      End With
      m = m + 1
      brr(m, 1) = DateValue(Split(arr(12, 1), ", ")(1))
      brr(m, 2) = Trim(Mid(arr(4, 1), 19, 16))
      brr(m, 3) = Trim(Mid(arr(8, 1), 19, 16))
'       ……后面的看不出来规律，自己填写吧
Next
ActiveSheet.UsedRange.Offset(2).ClearContents
[a3].Resize(m, 47) = brr
Application.ScreenUpdating = True
End Sub

A.rar (17.41 KB, 下载次数: 62)

		自动登录	找回密码
密码			免费注册

跪求TXT转EXCEL VBA 代码！

回复 2楼蓝桥玄霜的帖子

回复 4楼 Zamyi 的帖子

回复 6楼 leo2011 的帖子

跪求TXT转EXCEL VBA 代码！

回复 2楼 蓝桥玄霜 的帖子

回复 4楼 Zamyi 的帖子

回复 6楼 leo2011 的帖子

回复 2楼蓝桥玄霜的帖子