txt批量导入excel

qixl · 发表于 2013-3-23 13:51

我这是有很多个txt文件，我想把同一个文件夹下的txt文件批量导入到一个excel里，每个text文件导入成一个工作表，工作表名称为相应有txt文件名，txt数据以空格分隔，导入后为数值，这样我可以进行汇总计算，请问有哪个高手能够指点一下？

批量导入.part02.rar (114.18 KB, 下载次数: 140)

批量导入.part01.rar (292.97 KB, 下载次数: 156)

alzeng · 发表于 2013-3-23 14:13

Sub addSht()
Dim Fso As Object, Fl As Object
Dim oClp As Object, Str$, i%, m%
Set Fso = CreateObject("Scripting.FileSystemObject")
Set oClp = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
For Each Fl In Fso.getfolder(ThisWorkbook.Path & "/").Files
If Fl.Name Like "*.txt" Then
i = i + 1
If i > Sheets.Count Then Sheets.Add after:=Sheets(Sheets.Count)
Sheets(i).Name = Replace(Fso.getfilename(Fl), ".txt", "")
Open Fl For Input As #1
Str = StrConv(InputB(LOF(1), 1), vbUnicode): Reset
For m = 1 To 10
Str = Replace(Str, " ", " ")
Next
oClp.settext Replace(Str, " ", vbTab)
oClp.putinclipboard
Sheets(i).Paste Sheets(i).[A1]
oClp.Clear
End If
Next
Set oClp = Nothing
End Sub

复制代码

alzeng · 发表于 2013-3-23 14:17

批量导入.rar (143.37 KB, 下载次数: 868)

qixl · 发表于 2013-3-23 14:21

alzeng 发表于 2013-3-23 14:13

完美！！非常感谢！！！

wxxark · 发表于 2013-3-23 17:17

如果同样的事是有很多个EXCEL文件怎么做！

alzeng · 发表于 2013-3-23 17:50

wxxark 发表于 2013-3-23 17:17
如果同样的事是有很多个EXCEL文件怎么做！

论坛类似的实例有很多，建议你搜索看看。

wxxark · 发表于 2013-3-24 13:54

谢谢了提醒！

changhuijiang · 发表于 2014-2-27 20:31

alzeng 发表于 2013-3-23 14:13

求问VBA大神，我的txt文件前面有6行数据不想要，而txt文件数据中有些行第一列数据有的前面有一个空格，这样用该方法导入的话，就引起数据和对应的列标题错一列（列标题前面没有空格），我的意思是看能不能粘贴数据之前先做个判断之类的，由于我的txt文件有500多个，手工修改格式工作量太大了，请问大神可以修改吗，具体情况看我的数据文件

数据例子.zip (10 KB, 下载次数: 30)

liulang0808 · 发表于 2014-2-27 21:06

changhuijiang 发表于 2014-2-27 20:31
求问VBA大神，我的txt文件前面有6行数据不想要，而txt文件数据中有些行第一列数据有的前面有一个空格，这 ...

Sub Macro1()
Dim rng As Range

   Workbooks.OpenText Filename:=ThisWorkbook.Path & "\数据例子.txt", Origin:= _
      936, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
      Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3 _
      , 1)), TrailingMinusNumbers:=True
   Set txt1 = ActiveWorkbook

   r = txt1.Sheets(1).Cells.Find("*", , , , 1, 2).Row
For j = 7 To r

      If Len(txt1.Sheets(1).Cells(j, 1)) = 0 Then
         If rng Is Nothing Then
            Set rng = txt1.Sheets(1).Cells(j, 1)
         Else
            Set rng = Union(rng, txt1.Sheets(1).Cells(j, 1))
         End If
      End If
Next j
rng.Delete Shift:=xlToLeft

txt1.Sheets(1).Rows("1:6").Delete Shift:=xlUp
End Sub

changhuijiang · 发表于 2014-2-27 21:27

liulang0808 发表于 2014-2-27 21:06
Sub Macro1()
Dim rng As Range

我的rxt文件很多，我想都导入到一个excel文件中，每个txt对应一个工作薄，而且文件时xls格式的

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

[求助] txt批量导入excel