注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

我的博客

 
 
 

日志

 
 

通过VBA宏合并Excel工作表  

2010-08-05 12:23:34|  分类: 办公 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

通过VBA宏合并Excel工作表

2010年01月20日 发表于 代码珠玑 | 标签: excel , vba 21 条评论 | 阅读 2661 次

今天火车票到手,最重要的事情搞定啦,庆祝一下~

昨天跟盼盼说要写一篇她看得懂的,小路从来都是言而有信的人~想了半天,对于Excel,我只会玩宏,所以有了这一篇日志~

咳咳,切入正题。工作中经常会用到的把几个Excel文件合并到一个,或者是把一个Excel文件里的所有Sheet合并到一个Sheet来进行统计。下面分别提供用vba宏来解决这两个问题的方法~

1. 合并Excel文件

打开一个空Excel文件,Alt+F11,插入一个模块,开始写代码吧:

01 Sub MergeWorkbooks()
02     Dim FileSet
03     Dim i As Integer
04      
05     On Error GoTo 0
06     Application.ScreenUpdating = False
07   
08     FileSet = Application.GetOpenFilename(FileFilter:="Excel 2003(*.xls),*.xls,Excel 2007(*.xlsx),*.xlsx", _
09                                             MultiSelect:=True, Title:="选择要合并的文件")
10      
11     If TypeName(FileSet) = "Boolean" Then
12         GoTo ExitSub
13     End If
14      
15     For Each Filename In FileSet
16         Workbooks.Open Filename
17         Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
18     Next
19      
20 ExitSub:
21     Application.ScreenUpdating = True
22      
23 End Sub

这段代码在干嘛?它首先打开一个文件选择框,你可以选择一个或多个文件,然后把这些文件里的所有Sheet合并到当前这个工作簿里来,有重名的Sheet会自动在后面加数字。嗯,接下来可以进行第二歩鸟~

2. 合并工作表

同上,再添加一个模块吧,代码如下

01 Function LastRow(sh As Worksheet)
02     On Error Resume Next
03     LastRow = sh.Cells.Find(what:="*", _
04                             After:=sh.Range("A1"), _
05                             Lookat:=xlPart, _
06                             LookIn:=xlFormulas, _
07                             SearchOrder:=xlByRows, _
08                             SearchDirection:=xlPrevious, _
09                             MatchCase:=False).Row
10     On Error GoTo 0
11 End Function
12   
13 Sub MergeSheets()
14     Dim sh As Worksheet
15     Dim DestSh As Worksheet
16     Dim Last As Long
17     Dim shLast As Long
18     Dim CopyRng As Range
19     Dim StartRow As Long
20   
21     Application.ScreenUpdating = False
22     Application.EnableEvents = False
23   
24     '新建一个“汇总”工作表
25     Application.DisplayAlerts = False
26     On Error Resume Next
27     ActiveWorkbook.Worksheets("汇总").Delete
28     On Error GoTo 0
29     Application.DisplayAlerts = True
30     Set DestSh = ActiveWorkbook.Worksheets.Add
31     DestSh.Name = "汇总"
32   
33     '开始复制的行号,忽略表头,无表头请设置成1
34     StartRow = 2
35   
36     For Each sh In ActiveWorkbook.Worksheets
37   
38         If sh.Name <> DestSh.Name Then
39             Last = LastRow(DestSh)
40             shLast = LastRow(sh)
41   
42             If shLast > 0 And shLast >= StartRow Then
43   
44                 Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
45   
46                 If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
47                     MsgBox "内容太多放不下啦!"
48                     GoTo ExitSub
49                 End If
50   
51                 CopyRng.Copy
52                 With DestSh.Cells(Last + 1, "A")
53                     .PasteSpecial xlPasteValues
54                     .PasteSpecial xlPasteFormats
55                     Application.CutCopyMode = False
56                 End With
57             End If
58         End If
59     Next
60   
61 ExitSub:
62     Application.GoTo DestSh.Cells(1)
63     DestSh.Columns.AutoFit
64     Application.ScreenUpdating = True
65     Application.EnableEvents = True
66      
67 End Sub

这一大坨又在干嘛?它会新建一个叫做“汇总”的工作表,然后把当前工作簿里的所有Sheet里有数据的内容都复制到“汇总”表里。提示:如果数据表里的内容没有表头的话需要把StartRow = 2改成StartRow = 1哦。

  评论这张
 
阅读(1633)| 评论(1)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017