【求助】Excel批量导入TXT文本本件

曾经我寂寞无聊的时候帮人写过程序干这个。。。 【 在 magicstone (Natural Relish) 的大作中提到: 】 : 一个农科院的同学求助，他手头有批量的txt文件需要导入excel表格。txt内容是不同观察站水气压数据，每天的数据放在一个txt文件里，并以日期命名，一年的365个txt放在一个文件夹下，文件夹以年命名，共有从1971年到现在的40年数据。即40 X 365 = 14600 个txt文件。 : 问题来了，他需要把这些txt导入excel中，每一天的数据存放在一个sheet中，sheet以文件名即日期命名，每一年的365个sheet放在一个excel文件中，即导入数据后，共有40个excel文件，每个excel中365个sheet，每个sheet对应一天的数据。 : 求方法？望大牛不吝赐教。excel为2007。单个txt可以直接由excel导入，txt本身是有格式的，单独导入sheet中不存在问题。试过宏操作，没成功。 : ...................

源程序能给我一份么，谢谢了。 【 在 police 的大作中提到: 】 : 曾经我寂寞无聊的时候帮人写过程序干这个。。。 : 【 在 magicstone (Natural Relish) 的大作中提到: 】 : : 一个农科院的同学求助，他手头有批量的txt文件需要导入excel表格。txt内容是不同观察站水气压数据，每天的数据放在一个txt文件里，并以日期命名，一年的365个txt放在一个文件夹下，文件夹以年命名，共有从1971年到现在的40年数据。即40 X 365 = 14600 个txt文件。 : ...................

找了半天也没找到。啊啊啊啊。 【 在 magicstone (Natural Relish) 的大作中提到: 】 : 源程序能给我一份么，谢谢了。

那能大概说个思路么？ 【 在 police 的大作中提到: 】 : 找了半天也没找到。啊啊啊啊。 : 【 在 magicstone (Natural Relish) 的大作中提到: 】 : : 源程序能给我一份么，谢谢了。 : ...................

其实那个宏挺简单的。。我当时就是录了一个。。然后改了改而已。。。 【 在 magicstone (Natural Relish) 的大作中提到: 】 : 那能大概说个思路么？

lz:2007or2003的最大sheet数为255个，不可能实现365个，所以，程序很简单，但是365个sheet就很难了

合并程序如下：但是操作txt数不要超过255个 Sub D20合并文本() 'made by fxw Dim fd As FileDialog Set fd = Application.FileDialog(msoFileDialogFilePicker) Dim newwb As Workbook Set newwb = Workbooks.Add newwb.Application.ActiveWindow.Caption = "MergeTXT.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 Set fd = Nothing 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 Sheets(1).Select Application.ScreenUpdating = True End Sub

咦。我记得2007里索引变长了？难道记错了。 【 在 fxw (重新开始拉~~) 的大作中提到: 】 : lz:2007or2003的最大sheet数为255个，不可能实现365个，所以，程序很简单，但是365个sheet就很难了