| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 153 人关注过本帖
标题:将多个excel文件合成一个excel文件出现问题,请帮忙看看哪里不对。
只看楼主 加入收藏
ictest
Rank: 2
等 级:论坛游民
帖 子:234
专家分:97
注 册:2010-2-17
结帖率:73.97%
  已结贴   问题点数:10  回复次数:2   
将多个excel文件合成一个excel文件出现问题,请帮忙看看哪里不对。
我已经正常生成了一个summary文件和N个Map文件,都是EXCEL文件,现要求生成一个新的EXCEL文件,把Summary文件内容copy到新文件的Sheet1位置,其他的MAP文件按照顺序依次拷贝的新excel文件中,程序我也编写了,但现在问题是编译后在十次里面偶尔会出现一两次Sheet1位置为空白,也就是Summary文件内容没有copy到新文件的Sheet1位置,其他MAP文件倒是都拷贝进去了,这是怎么回事呢?麻烦帮看看我的程序里有什么问题吧?谢谢大家了!!

程序代码:
If Dir(Dir1.Path & "\合并导出", vbDirectory) = "" Then MkDir Dir1.Path & "\合并导出" '如果不存在文件夹则创建之

If Dir(Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.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 (Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.xlsx")

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(Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.xlsx")
    Set newBook4 = XlApp.Workbooks.Open(Dir1.Path & "\SUMMARY.xlsx")
     newBook2.Worksheets("Sheet3").Delete
     newBook2.Worksheets("Sheet2").Delete

    newBook4.Sheets("sheet1").Name = "统计信息"
    newBook4.Sheets("统计信息").Copy after:=newBook2.Sheets(newBook2.Sheets.Count)

    For i = 0 To File2.ListCount - 1
   
    Set newBook1 = XlApp.Workbooks.Open(Dir1.Path & "\封装图导出\" & File2.List(i))
    newBook1.Sheets(1).Copy after:=newBook2.Sheets(newBook2.Sheets.Count)
 
    newApp.Visible = False
   
   
    Next i
   

 newBook2.Worksheets("Sheet1").Delete
 newBook2.SaveAs (Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.xlsx")
 
 
 xlBook.SaveAs (Dir1.Path & "\合并导出\" & Trim(Label38.Caption) & "_MAP.xlsx")
'在退出窗体前,释放excel相应变量

 
    newApp.Visible = False
     XlApp.DisplayAlerts = False '不显示对话框
   
    Set newBook1 = Nothing
    Set newBook2 = Nothing
    Set newBook3 = Nothing
    Set newBook4 = Nothing

Set newApp = Nothing
xlBook.Close
Set xlsheet = Nothing
Set xlBook = Nothing
XlApp.Quit
Set XlApp = Nothing


2019-01-07 12:15
ictest
Rank: 2
等 级:论坛游民
帖 子:234
专家分:97
注 册:2010-2-17
  得分:0 
没有谁能帮我一下吗?
2019-01-09 20:53
wds1
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:33
帖 子:344
专家分:1801
注 册:2016-3-10
  得分:10 
1、程序增加一个延时函数
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Sub sleep(seconds As Integer)
Dim temp As Variant
temp = timeGetTime
  While timeGetTime - seconds < temp
  DoEvents
  Wend
End Sub
2、执行 newBook4.Sheets("统计信息").Copy后调用延时函数
  call sleep(1000)'这个是延时1秒。
 
  我认为你执行copy命令后,数据没有copy成功,就执行了保存操作。
  而且数据量越大,应该空白的越多,你自己测试一下。
2019-01-09 22:11







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

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