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

Excel 技巧网

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 2144|bwin官网地址: 4

[待分类提问] 将多个Excel表中多个sheet数据汇总到一个Excel表中的对应sheet

[复制链接]
发表于 2015-12-21 15:29:16 | 显示全部楼层 |阅读模式

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

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

x
各位老师好!

我想实现一个功能:将多个Excel表(如表1、表2、表3)中多个sheet(如A、B、C、D)数据汇总到一个Excel表中的对应sheet,如附件中的“表1、表2、表3”三个Excel中的数据汇总到“汇总”Excel中。请教老师们怎么用VBA来实现呢

汇总多个Excel表中对应sheet的数据.rar

29.74 KB, 下载次数: 39

要实现的功能举例

发表于 2015-12-23 13:15:41 | 显示全部楼层
  1. Option Explicit

  2. Sub text()
  3.     Dim mypath$, myfile$, i&, r&
  4.     Dim wb As Workbook
  5.     Dim sht As Worksheet
  6.     Dim sh As Worksheet
  7.     mypath = ThisWorkbook.Path & ""
  8.     myfile = Dir(mypath & "*.xlsx")
  9.     For Each sh In Worksheets
  10.         sh.Cells.Clear
  11.     Next
  12.     Application.ScreenUpdating = False
  13.     With ThisWorkbook
  14.         Do While myfile <> ""
  15.             If myfile <> .Name Then
  16.                 Set wb = Workbooks.Open(mypath & myfile)
  17.                 i = i + 1
  18.                 For Each sht In wb.Worksheets
  19.                     r = .Sheets(sht.Name).[a65536].End(3).Row
  20.                     If i = 1 Then
  21.                         wb.Sheets(sht.Name).UsedRange.Copy .Sheets(sht.Name).Cells(i, 1)
  22.                     Else
  23.                         i = r + 1
  24.                         wb.Sheets(sht.Name).UsedRange.Offset(1).Copy .Sheets(sht.Name).Cells(i, 1)
  25.                     End If
  26.                 Next
  27.                 wb.Close
  28.             End If
  29.             myfile = Dir
  30.         Loop
  31.     End With
  32.     Application.ScreenUpdating = True
  33. End Sub
复制代码
 楼主| 发表于 2015-12-23 17:51:44 | 显示全部楼层

可以了,谢谢大虾,,太感谢了
发表于 2015-12-24 15:48:00 | 显示全部楼层
  1. Option Explicit

  2. Dim n As Integer
  3. Sub text()
  4.     Dim i%, m%, mypath$, myfile$, sql$
  5.     Dim con As New ADODB.Connection
  6.     Dim rs As New ADODB.Recordset
  7.     n = n + 1
  8.     Sheets(n).Cells.Clear
  9.     mypath = ThisWorkbook.Path & ""
  10.     myfile = Dir(mypath & "*.xlsx")
  11.     Do While myfile <> ""
  12.         If myfile <> ThisWorkbook.Name Then
  13.             i = i + 1
  14.             If i = 1 Then
  15.                 con.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & _
  16.                 mypath & myfile
  17.                 sql = "select * from [" & Sheets(n).Name & "$]"
  18.             Else
  19.                 sql = sql & "union all select * from [excel 12.0;database=" & _
  20.                 mypath & myfile & "].[" & Sheets(n).Name & "$]"
  21.             End If
  22.         End If
  23.         myfile = Dir
  24.     Loop
  25.     rs.Open sql, con, adOpenKeyset, adLockOptimistic
  26.     For m = 0 To rs.Fields.Count - 1
  27.         Sheets(n).Cells(1, m + 1) = rs.Fields(m).Name
  28.     Next
  29.     Sheets(n).Cells(2, 1).CopyFromRecordset rs
  30.     rs.Close: Set rs = Nothing
  31.     con.Close: Set con = Nothing
  32.     If n < Sheets.Count Then Call text Else End
  33. End Sub
复制代码
发表于 2019-3-6 11:45:18 | 显示全部楼层

你好,我按这个程序运行之后为什么EXCEL的表格被清空了,是为什么了?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

关闭

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

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

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速bwin官网地址 返回顶部 返回列表