| 网站首页 | 业界新闻 | 群组 | 人才 | 技术文章 | 下载频道 | 博客 | 代码贴 | 编程论坛
共有 236 人关注过本帖
标题:合并多个excel文件遇到的问题
只看楼主 收藏
ictest
Rank: 2
等 级:论坛游民
帖 子:177
专家分:53
注 册:2010-2-17
结帖率:71.43%
  已结贴   问题点数:20  回复次数:8   
合并多个excel文件遇到的问题
目的:将多个excel文件中的工作簿(map)提取出并全部集中到一个新文件中。

详细解释:例如一个目录下有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


附件为用于做实验用的25个excel文件。


求版主和大神们帮助帮助我。告诉我程序中哪里错了和如何修改,多谢多谢!!
附件: 您没有浏览附件的权限,请 登录注册
2017-09-06 00:34
ictest
Rank: 2
等 级:论坛游民
帖 子:177
专家分:53
注 册:2010-2-17
  得分:0 
求版主和路过的大神们帮助帮助我。告诉我程序中哪里错了和如何修改,多谢多谢!
2017-09-06 08:42
xiangyue0510
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:74
帖 子:779
专家分:4610
注 册:2015-8-10
  得分:10 
你这个代码就是只能实现“Map” +“25”的效果
因为你每次都只是打开一个 0X.xlsx,将“Map”复制之后修改为“X”。 最后保存为1.xlsx,每次都是将上次的结果覆盖掉。
所以你只有两个sheet“Map”、“X”。 循环25次当然就是“Map” +“25”
你需要做的是将“Map”从0X.xlsx复制到1.xlsx
下面是VBA的宏的代码自己研究修改一下

Workbooks("01.xlsx").Sheets("Map").Copy Before:=Workbooks("1.xlsx").Sheets(1)
Sheets("Map").Name = "01"
2017-09-06 08:59
ictest
Rank: 2
等 级:论坛游民
帖 子:177
专家分:53
注 册:2010-2-17
  得分:0 


真对不起,VBA 实在不会,您的这两句我能读懂,但由于因为它们之间的一些写法上的差异,感到无所适从,思考和尝试了一下午,还是不会修改成VB语言应用到我的代码中,真是不好意思。



恳求您的帮助  。
2017-09-06 16:24
xiangyue0510
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:74
帖 子:779
专家分:4610
注 册:2015-8-10
  得分:0 
回复 4楼 ictest
不就是一样的么,区别就是VB需要创建对象,VBA可以直接使用而已
VBA

Workbooks("01.xlsx").Sheets("Map").Copy Before:=Workbooks("1.xlsx").Sheets(1)
Sheets("Map").Name = "01"

VB
程序代码:

Set xlBook = xlApp.Workbooks.Open(Dir1.Path & "\01.xlsx")
Set xlBook2 = xlApp.Workbooks.Open("C:\01.xlsx")
xlBook.Sheets("Map").Copy Before:=xlBook2.Sheets(1)
xlBook2.Sheets("Map").Name = "01"

2017-09-06 16:46
ictest
Rank: 2
等 级:论坛游民
帖 子:177
专家分:53
注 册:2010-2-17
  得分:0 
感谢xiangyue0510版主,在你的帮助下,终于可以将多个EXCEL文件中的"map"sheet提取集中到一个新文件中了。
但现在又出现了一个新问题:
在新文件中,Sheet的排列方式有问题,现在生成的排列方式为:
25、24、23、22......3、2、1
这是怎么回事呢?

请xiangyue0510版主以及其他路过的版主和朋友们帮看看我的代码中哪里有问题,并请告知如何修改,谢谢!!
另,测试用的EXCEL文件在一楼。 谢谢各位了!

程序代码:
    Dim xlApp As Object ' Excel.Application
    Dim xlBook As Object ' Excel.Workbook
    Dim xlsheet As Object 'Excel.Worksheet
    Dim newApp As New Excel.Application
    Dim newBook1 As New Excel.Workbook
    Dim newBook2 As New Excel.Workbook

Private Sub Command1_Click()
If Dir("c:\temp.xlsx") = "" Then
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    xlApp.Visible = False
    Set xlsheet = xlBook.Worksheets(3)
    xlApp.ScreenUpdating = False  '屏幕更新关

xlBook.SaveAs "c:\temp.xlsx"
'在退出窗体前,释放excel相应变量

xlBook.Close
Set xlsheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing  '注意:xlApp要先Quit,后Nothing
End If

    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add

    xlApp.DisplayAlerts = False '不显示对话框
    Set newBook2 = xlApp.Workbooks.Open("c:\temp.xlsx")

    For i = 0 To File1.ListCount - 1
   
    Set newBook1 = xlApp.Workbooks.Open(Dir1.Path & "\" & File1.List(i))
   
    newBook1.Sheets("Map").Copy after:=newBook2.Sheets(Sheets.Count)
    newBook2.Sheets("Map").Name = i + 1
   
    newApp.Visible = False
    Next i
   
' newBook2.SaveAs "c:\导出.xlsx"
newBook2.Worksheets("Sheet3").Delete
 newBook2.Worksheets("Sheet2").Delete
 newBook2.Worksheets("Sheet1").Delete
 newBook2.SaveAs "c:\temp.xlsx"
   
    Set newBook1 = Nothing
    Set newBook2 = Nothing
    Set newApp = Nothing

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



2017-09-06 22:04
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:180
帖 子:4005
专家分:24695
注 册:2008-10-15
  得分:10 
    newBook1.Sheets("Map").Copy after:=newBook2.Sheets(Sheets.Count)

两种添加方式,看来你需要根据你的要求选择
after    之后
Before   之前

1、对原文件名进行排序,从小的开始复制起,每次都使用 之后。

2、每次复制时,查找 表的名字,然后 对应插入到位置中去。


授人于鱼,不如授人于渔
早已停用QQ了
2017-09-07 08:31
xiangyue0510
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:74
帖 子:779
专家分:4610
注 册:2015-8-10
  得分:0 
VBA里面自己研究一下么,无非就是after和before,还有就是指定插入之前或者之后的sheet的名称
2017-09-07 08:51
ictest
Rank: 2
等 级:论坛游民
帖 子:177
专家分:53
注 册:2010-2-17
  得分:0 
嗯嗯,谢谢两位版主的指教,我把  newBook1.Sheets("Map").Copy after:=newBook2.Sheets(Sheets.Count)做了修改,
改成  newBook1.Sheets("Map").Copy after:=newBook2.Sheets(newBook2.Sheets.Count) ,这样就对了。

所以说,“一语惊醒梦中人”这句话还是对的,自己往往会迷失在自己的思路中,高人的一句指点,就会直击要害,令人醍醐灌顶,恍然大悟,谢谢两位的指导!
2017-09-07 09:32









关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.097017 second(s), 8 queries.
Copyright©2004-2017, BCCN.NET, All Rights Reserved