本帖最后由 pcl_test 于 2017-6-7 21:24 编辑
求高手!
由于工作中经常需要合并XLS文件,手动太耗时,所以找到这个程序。
目前这个程序能够合并单个表 如果整个XLS文件中有多个分表就不知道要如何改了
例如:有三个格式一样的XLS文件,希望把三个文件的Sheet1、Sheet2、Sheet3 合并到新文件也以Sheet1、Sheet2、Sheet3 的形式呈现。
还有个小小请求以下代码求翻译- x=inputbox("请输入每个文件表头所占的行数:")
- Set WshShell = WScript.CreateObject("WScript.Shell")
- Set fso = CreateObject("Scripting.FileSystemObject")
- set xlsapp = CreateObject("excel.Application")
- xlsapp.visible=true
- set hb=xlsapp.workbooks.add
- hb.saveas(WshShell.CurrentDirectory & "\合并.xls")
- Set myfolder = fso.GetFolder(WshShell.CurrentDirectory)
- index=1
- For Each myfile In myfolder.Files
- if InStr(myfile.name,".xls")<>0 and InStr(myfile.name,"合并.xls")=0 and InStr(myfile.name,"$")=0 then
- set temp=xlsapp.workbooks.open(WshShell.CurrentDirectory & "\" & myfile.name)
- if index=1 then
- temp.Worksheets(1).Rows("1:" & temp.Worksheets(1).UsedRange.Rows.Count).Copy
- else
- temp.Worksheets(1).Rows((x+1) & ":" & temp.Worksheets(1).UsedRange.Rows.Count).Copy
- end if
- hb.Worksheets(1).Rows(index).PasteSpecial
- fnl=Len(myfile.Name)
- For i = index To hb.Worksheets(1).UsedRange.Rows.Count
- hb.Worksheets(1).Cells(i,temp.Worksheets(1).UsedRange.Columns.Count+1).Value = Left(myfile.Name,fnl-4)
- Next
- hb.Save
- index=hb.Worksheets(1).UsedRange.Rows.Count+1
- temp.close
- set temp=Nothing
- end if
- next
- hb.worksheets(1).columns.autofit
- hb.save
- hb.close
- set hb=nothing
- set myfolder=nothing
- xlsapp.quit
- Set xlsapp= Nothing
- Set fso = Nothing
- Set wshell = Nothing
- MsgBox "OK,请打开合并.xls"
复制代码
|