|
#2
ictest2017-09-06 08:42
|
详细解释：例如一个目录下有01.xlsx~25.xlsx文件，每个xlsx文件中都有一个名为“map”的sheet（且每个xlsx文件中都只有一个sheet）。现在我想把每个文件中的名为“map”的sheet提取出来，合并到一个新的文件“1.xlsx”中。并且每提取一个名为“map”的sheet写入新文件后将该sheet名“map”改成“1”~“25”（序号）。
例如，
提取了01.xlsx文件中的“map”工作簿后，写入1.xlsx，将sheet“map”改成“1”；
提取了02.xlsx文件中的“map”工作簿后，写入1.xlsx，将sheet“map”改成“2”；
提取了03.xlsx文件中的“map”工作簿后，写入1.xlsx，将sheet“map”改成“3”；
。
。
。
提取了25.xlsx文件中的“map”工作簿后，写入1.xlsx，将sheet“map”改成“25”；
全部文件提取写入完后，打开1.xlsx查看，内部应该有25个sheet，名字分别是“1”~“25”（按文件读取写入的顺序排列）。
目前问题：全部文件提取写入完后，打开1.xlsx查看，内部只有两个sheet，一个是“map”，一个是“25”，查看“map”sheet内容，是25.xlsx内容。也就是说，在读取新的excel文件后，写入并不是向后添加，而是不断的覆盖，所有文件提取写入完后，新文件中只保留了最后一个文件内容，并且这个“map”sheet我不需要，只要序号sheet就行了。
程序源码：
程序代码：Private Sub Command1_Click()
Dim S() As String, i As Integer, j As Integer
Dim xlApp
Dim xlBook
Dim xlSheet
For i = 0 To File1.ListCount - 1
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
xlApp.DisplayAlerts = False '不显示对话框
Set xlBook = xlApp.Workbooks.Open(Dir1.Path & "\" & File1.List(i)) '打开已经存在的EXCEL工件簿文件
xlApp.Visible = False '设置EXCEL对象可见（或不可见）
Set xlSheet = xlBook.Worksheets("map") '设置活动工作表
xlSheet.Cells.Select
xlSheet.Cells.Copy
'xlApp.Workbooks.Add
xlBook.Worksheets.Add(after:=xlBook.Worksheets("map")).Name = (i + 1)
xlApp.ActiveSheet.Paste
xlApp.Application.CutCopyMode = False
xlApp.ActiveWorkbook.SaveAs FileName:="c:\1.xlsx" '保存工作表,
xlBook.Close (True) '关闭工作簿 这里的True表示退出时保存修改
xlApp.Quit '结束EXCEL对象
Set xlApp = Nothing '释放xlApp对象
Next i
MsgBox "ok"
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
'File1.Refresh
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
File1.Pattern = "*.xlsx"
End Sub
Dim S() As String, i As Integer, j As Integer
Dim xlApp
Dim xlBook
Dim xlSheet
For i = 0 To File1.ListCount - 1
Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象
xlApp.DisplayAlerts = False '不显示对话框
Set xlBook = xlApp.Workbooks.Open(Dir1.Path & "\" & File1.List(i)) '打开已经存在的EXCEL工件簿文件
xlApp.Visible = False '设置EXCEL对象可见（或不可见）
Set xlSheet = xlBook.Worksheets("map") '设置活动工作表
xlSheet.Cells.Select
xlSheet.Cells.Copy
'xlApp.Workbooks.Add
xlBook.Worksheets.Add(after:=xlBook.Worksheets("map")).Name = (i + 1)
xlApp.ActiveSheet.Paste
xlApp.Application.CutCopyMode = False
xlApp.ActiveWorkbook.SaveAs FileName:="c:\1.xlsx" '保存工作表,
xlBook.Close (True) '关闭工作簿 这里的True表示退出时保存修改
xlApp.Quit '结束EXCEL对象
Set xlApp = Nothing '释放xlApp对象
Next i
MsgBox "ok"
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
'File1.Refresh
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
File1.Pattern = "*.xlsx"
End Sub
附件为用于做实验用的25个excel文件。
只有本站会员才能查看附件，请 登录
求版主和大神们帮助帮助我。告诉我程序中哪里错了和如何修改，多谢多谢！！
