如何用VBA导入几个TXT文件到同一个工作表里去。模板都一样就数据有点出入。挺急的麻烦哪位大大出手吧多谢

2013-11-23

怎么用VBA导入几个TXT文件到同一个工作表里去。模板都一样就数据有点出入。挺急的麻烦哪位大大出手吧谢谢。本

怎么用VBA导入几个TXT文件到同一个工作表里去。模板都一样就数据有点出入。挺急的麻烦哪位大大出手吧谢谢。
本帖最后由 jie648941262 于 2012-09-11 17:48:09 编辑 Sub 读取数据()
     'made by fxw
     Dim fd As FileDialog
     Set fd = Application.FileDialog(msoFileDialogFilePicker)
     Dim newwb As Workbook
    Set newwb = Workbooks.Add
    newwb.Application.ActiveWindow.Caption = "临时数据.xls"
     With fd
             .Filters.Clear
             .Filters.Add "文本文件", "*.txt", 1
             .Filters.Add "所有文件", "*.*", 2
             .Title = " 请选择要合并的txt文件 "
         If .Show = -1 Then
             Application.ScreenUpdating = False
             Dim vrtSelectedItem As Variant
             Dim i As Integer
             i = 1
             For Each vrtSelectedItem In .SelectedItems
                 Dim tempwb As Workbook
                 Set tempwb = Workbooks.Open(vrtSelectedItem)
                 tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)
                 newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".txt", "")
                 tempwb.Close savechanges:=False
                i = i + 1
             Next vrtSelectedItem
             Else:
             newwb.Close savechanges:=False
             Exit Sub
         End If
     End With
Sheets(1).Select
Range("A1").Select
     If ActiveWorkbook.Sheets.Count > 3 Then
     Sheets("Sheet1").Select
     Application.DisplayAlerts = False
     ActiveWindow.SelectedSheets.Delete
     Application.DisplayAlerts = True
     Sheets("Sheet2").Select
     Application.DisplayAlerts = False
     ActiveWindow.SelectedSheets.Delete
     Application.DisplayAlerts = True
     Sheets("Sheet3").Select
     Application.DisplayAlerts = False
     ActiveWindow.SelectedSheets.Delete
     Application.DisplayAlerts = True
     End If
     Application.ScreenUpdating = True
      Selection.AutoFilter    '筛选
End Sub

大家帮帮忙吧。困在这里面一个星期了。现在是每一个TXT文件生成一个工作表，我想要的是不管选择几个TXT文件都输出在同一个表上。
[解决办法]
楼主试试这个：

         Application.ScreenUpdating = False
         Dim vrtSelectedItem As Variant
         Dim i As Integer
         Dim iLineCount As Long
         i = 1
         iLineCount = 1
         Application.DisplayAlerts = False
         For Each vrtSelectedItem In .SelectedItems
            Dim TempWB As Workbook
            Set TempWB = Workbooks.Open(vrtSelectedItem)
            'TempWB.Worksheets(1).Copy Before:=NewWB.Worksheets(i)
            'NewWB.Worksheets(i).Name = Replace(TempWB.Name, ".txt", "")
            'TempWB.Close savechanges:=False
            'i = i + 1
            i = TempWB.Sheets(1).UsedRange.Rows.Count
            TempWB.Sheets(1).Range("1:" & i).Copy
            NewWB.Sheets(1).Paste NewWB.Sheets(1).Range("A" & iLineCount)
            TempWB.Close False
            iLineCount = iLineCount + i
         Next
      Else
         NewWB.Close False
         Exit Sub
      End If
   End With
   Sheets(1).Select
   Range("A1").Select
   'If ActiveWorkbook.Sheets.Count > 3 Then
   '   Sheets("Sheet1").Select
   '   Application.DisplayAlerts = False
   '   ActiveWindow.SelectedSheets.Delete
   '   Application.DisplayAlerts = True
   '   Sheets("Sheet2").Select
   '   Application.DisplayAlerts = False
   '   ActiveWindow.SelectedSheets.Delete
   '   Application.DisplayAlerts = True
   '   Sheets("Sheet3").Select
   '   Application.DisplayAlerts = False
   '   ActiveWindow.SelectedSheets.Delete
   '   Application.DisplayAlerts = True
   'End If
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
   Selection.AutoFilter    '筛选
End Sub

[解决办法]
楼主试试这个：

Sub 读取数据()
   'made by fxw
   Dim fd As FileDialog
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   Dim NewWB As Workbook
   Set NewWB = Workbooks.Add
   NewWB.Application.ActiveWindow.Caption = "临时数据.xls"
   With fd
      .Filters.Clear
      .Filters.Add "文本文件", "*.txt", 1
      .Filters.Add "所有文件", "*.*", 2
      .Title = " 请选择要合并的txt文件 "
      If .Show = -1 Then
         Application.ScreenUpdating = False
         Dim vrtSelectedItem As Variant
         Dim i As Integer
         Dim iLineCount As Long
         i = 1
         iLineCount = 1
         Application.DisplayAlerts = False
         For Each vrtSelectedItem In .SelectedItems
            Dim TempWB As Workbook
            Set TempWB = Workbooks.Open(vrtSelectedItem)
            'TempWB.Worksheets(1).Copy Before:=NewWB.Worksheets(i)
            'NewWB.Worksheets(i).Name = Replace(TempWB.Name, ".txt", "")

            'TempWB.Close savechanges:=False
            'i = i + 1
            i = TempWB.Sheets(1).UsedRange.Rows.Count
            TempWB.Sheets(1).Range("1:" & i).Copy
            NewWB.Sheets(1).Paste NewWB.Sheets(1).Range("A" & iLineCount)
            TempWB.Close False
            iLineCount = iLineCount + i
         Next
      Else
         NewWB.Close False
         Exit Sub
      End If
   End With
   Sheets(1).Select
   Range("A1").Select
   'If ActiveWorkbook.Sheets.Count > 3 Then
   '   Sheets("Sheet1").Select
   '   Application.DisplayAlerts = False
   '   ActiveWindow.SelectedSheets.Delete
   '   Application.DisplayAlerts = True
   '   Sheets("Sheet2").Select
   '   Application.DisplayAlerts = False
   '   ActiveWindow.SelectedSheets.Delete
   '   Application.DisplayAlerts = True
   '   Sheets("Sheet3").Select
   '   Application.DisplayAlerts = False
   '   ActiveWindow.SelectedSheets.Delete
   '   Application.DisplayAlerts = True
   'End If
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
   Selection.AutoFilter    '筛选
End Sub

[解决办法]

引用:

要把数据导入在当前工作簿的第2个工作表上。悲剧啊

我看你也是杯具……
你就不能自己动下脑吗？？？？

[解决办法]

引用:

要把数据导入在当前工作簿的第2个工作表上。悲剧啊

-_-!!!
真不知道你的“当前工作簿”是不是你正在操作、要导入新数据的工作薄。

如果是，就按我后面说的改吧。
把前面的这两句：
Set NewWB = Workbooks.Add
NewWB.Application.ActiveWindow.Caption = "临时数据.xls"
改成：
Set NewWB = ActiveWorkbook
Sheets(2).Select

后面的两处：NewWB.Sheets(1)
把 1 改成 2

把 End With 后面的那句：Sheets(1).Select
注释掉或删除。

这样应该就行了……
-_-!!!
自己怎么不想下如何做……

热点排行