设为首页收藏本站|繁體中文

Excel 技巧网

 找回密码
 注册

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 303|回复: 2

[待分类提问] 请教如何把多个文件去表头汇总到一个表格

[复制链接]
发表于 2018-7-8 21:18:40 | 显示全部楼层 |阅读模式

免费注册成为本站会员,享用更多功能,结识更多Office办公高手!

您需要 登录 才可以下载或查看,没有帐号?注册

x
首先确实对表格一窍不通,请教下各位 huizong.rar (23.42 KB, 下载次数: 5)
发表于 2018-7-14 10:31:28 | 显示全部楼层
两组代码
第一个先把几个工作表合并到一个工作表中
  1. Sub 进而()
  2. Dim filestoopen
  3. Dim x As Integer

  4. On Error GoTo errhandler
  5. Application.ScreenUpdating = False

  6. filestoopen = Application.GetOpenFilename _
  7. (filefilter:="microsoft excel文件(*.xls), *.xls", _
  8. MultiSelect:=True, Title:="")

  9. If TypeName(filestoopen) = "boolean" Then
  10. MsgBox "没有选中文件"
  11. GoTo exithandler
  12. End If

  13. x = 1
  14. While x <= UBound(filestoopen)
  15. Workbooks.Open Filename:=filestoopen(x)
  16. Sheets().Move after:=ThisWorkbook.Sheets _
  17. (ThisWorkbook.Sheets.Count)
  18. x = x + 1

  19. Wend

  20. exithandler:
  21. Application.ScreenUpdating = True
  22. Exit Sub

  23. errhandler:
  24. MsgBox Err.edscription
  25. Resume exithandler

  26. End Sub
复制代码


第二组代码把合并工作表下的所有工作簿合成一个工作表,不带表头的
  1. Sub MergeSheets()

  2.     Dim SrcBook As Workbook

  3.     Dim fso As Object, f As Object, ff As Object, f1 As Object

  4.     Dim intSheetCount, intCurSheet As Integer

  5.     Application.ScreenUpdating = False

  6.     Set fso = CreateObject("Scripting.FileSystemObject")

  7.     Set f = fso.Getfolder("c:\temp")

  8.     Set ff = f.Files
  9.    
  10.     For Each f1 In ff

  11.         Set SrcBook = Workbooks.Open(f1)

  12.         intSheetCount = SrcBook.Worksheets.Count

  13.         For intCurSheet = 1 To intSheetCount

  14.             If intCurSheet = 1 Then
  15.                SrcBook.Worksheets(intCurSheet).Range("A3:IV3" & SrcBook.Worksheets(intCurSheet).Range("A65536").End(xlUp).Row).Copy
  16.             Else
  17.                SrcBook.Worksheets(intCurSheet).Range("A1:IV" & SrcBook.Worksheets(intCurSheet).Range("A65536").End(xlUp).Row).Copy
  18.             End If
  19.             
  20.             ThisWorkbook.Worksheets(1).Activate

  21.             Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial

  22.             Application.CutCopyMode = False
  23.                         
  24.         Next

  25.         SrcBook.Close

  26.     Next

  27. End Sub
复制代码


注,两组代码都是基于xls格式
回复 支持 反对

使用道具 举报

发表于 2018-7-15 15:31:10 | 显示全部楼层
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

关闭

站长推荐上一条 /1 下一条

Excel技巧网的会员探讨问题仅代表其个人意见,与网站的立场无关。任何违反国家和地方相关法律法规的言论,本站有义务协助政府相关部门追究发言者的责任!
本站中非注明转载文章与案例的版权为作者与Excel技巧网共有。若非原文作者,本站之外任何单位或个人未经允许,不得将其用于商业用途。
若非原文作者,任何形式的非商业性转载必须获得Excel技巧网或作者允许,并注明作者和出处。
会员发表的帖子如涉及版权纠纷,须自行负责。详情请参考注册时的网站服务条款。
本站特聘法律顾问:沈学律师

Archiver|手机版|Excel技巧网 ( 闽ICP备08107682号-2 ) | 闽公网安备 35020302032608号  

GMT+8, 2018-9-22 08:00

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表