一、合并工作簿
Sub 合并工作簿()
   Application.ScreenUpdating = False
    myfile = Dir(ThisWorkbook.Path & "\*.xls*")'Dir函数,获取同路径下待合并excel的文件名
    Do While myfile <> ""  '当文件名不为空的时候,继续运行,如果为空,说明表格已经循环一个遍了
          If myfile <> ThisWorkbook.Name Then'在文件名不为空的前提下,还不能是代码所在的汇总工作簿
              Set wb = Workbooks.Open(ThisWorkbook.Path & "" & myfile)
              For m = 1 To wb.Worksheets.Count '对待汇总的工作簿中所有worksheet做循环
              rrow = wb.Worksheets(m).UsedRange.Rows.Count
              wb.Worksheets(m).Range("a1:d" & rrow).Copy ThisWorkbook.Worksheets(1).Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
              Next
              Workbooks(myfile).Close False'复制完数据以后,分表关闭,不保存。
          Else
        End If
       myfile = Dir '获取下一个待汇总工作簿的文件名
     
    Loop
   Application.ScreenUpdating = True
    MsgBox "完成"
End Sub
 
绿色部分为按自己需要修改的代码。文中代码框架是汇总A:D列内容。
这里着重说一下:代码使用环境是待合并工作簿和代码工作簿在同一个路径下。
 
Sub 合并工作簿()
   Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogFolderPicker) '创建一个浏览文件夹的对话框
       If .Show = -1 Then PathSht = .SelectedItems(1) Else Exit Sub
    End With
   源代码,省略不写了,记得把"ThisWorkbook.Path"改为"PathSht"     
    ....
End Sub
 
二、拆分工作簿
这段代码可以实现对工作簿任意列的拆分。(对某一列相同内容的所在行挑出来,汇总到一个新建工作簿里面)
Sub 拆分工作簿()
   Application.ScreenUpdating = False '关闭屏幕闪动,提速
   Application.DisplayAlerts = False '关闭窗口提示
    kk = 2
    Set dic = CreateObject("scripting.dictionary")
    With ThisWorkbook.Worksheets("待拆分的Sheet名")'根据自己的工作簿自行修改
       cln = InputBox("请输入需要按列拆分的列:" & Chr(10) & "英文列标", "输入列标", "A") 'inputbox提示输入需要拆分的列标
       cln2 = .Range("a1").End(xlToRight).Column '获取最大列数,为了增加通用性
       If .Range(cln & 2) = "" Then Exit Sub
       rrow = .Cells(Rows.Count, cln).End(xlUp).Row
       arr = WorksheetFunction.Transpose(.Range(cln & 1 & ":" & cln & rrow))
       For i = 1 To UBound(arr) '将拆分条件列数据写入字典,为了去重复。
           If Not dic.exists(arr(i)) Then '若字典中不存在该字符串,则写入。
           dic.Add arr(i), .Range("a" & i).Resize(1, cln2)
       Else
           Set dic.Item(arr(i)) = Union(dic.Item(arr(i)), .Range("a" & i).Resize(1, cln2))
       End If
    Next
    k = dic.keys
    l = dic.items
    For ss = 0 To dic.Count - 1
       Set wb = Workbooks.Add '新建工作簿
       With wb.Worksheets(1)
           l(ss).Copy .Range("a1")
       End With
       wb.SaveAs ThisWorkbook.Path & "" & k(ss) & ".xlsx" '将新建的工作簿保存在代码工作簿下
       wb.Close True '关闭工作簿,并保存
       Set wb = Nothing '释放内存
    Next
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "完成"
End Sub
 
上述代码默认从第一行拆分,如果有标题行不想拆分,可以把上述下句代码修改一下。
arr = WorksheetFunction.Transpose(.Range(cln & 1 & ":" & cln & rrow)),从哪一行开始拆分,就把1修改为行号
 
三、合并工作表(Sheet)
合并同一个工作簿下所有Sheet到一个Sheet里面就比较简单了。
Sub 合并当前工作簿下的所有Sheet()
Application.ScreenUpdating = False
For j = 1 To Sheets.Count
   If Sheets(j).Name <> ActiveSheet.Name Then
      X = Range("A65536").End(xlUp).Row + 1
      Sheets(j).UsedRange.Copy Cells(X, 1)'默认复制所有内容
   End If
Next
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "当前工作簿下的全部工作表已经合并完毕!", vbInformation, "提示"
End Sub
默认复制所有内容,如果有特定需要,自己修改这部分代码Sheets(j).UsedRange.Copy Cells(X, 1)'默认复制所有内容。
 
四、拆分工作表(Sheet)
Sub 拆分表格()
    Set d = CreateObject("scripting.dictionary")
    With Worksheets(1)
       rrow = .Cells(Rows.Count, "a").End(3).Row
       For i = 2 To rrow '从第2行开始拆分
           strr = .Range("c" & i).Value '拆分C列内容
           If Not d.exists(strr) Then
              d.Add strr, .Range("a" & i).Resize(1, 4)
           Else
              Set d.Item(strr) = Union(d.Item(strr), .Range("a" & i).Resize(1, 4))
           End If
       Next
       k = d.keys
       i = d.items
       For a = 0 To d.Count - 1
          Worksheets.Add.Name = k(a)
           i(a).Copy Worksheets(k(a)).Range("a2")
       Next
    End With
End Sub
 
上述代码用到了字典
 
For i = 2 To rrow '从第2行开始拆分
strr = .Range("c" & i).Value '拆分C列内容
 
根据自己实际需求修改代码即可。
 

【转载】EXCEL VBA 工作簿(表)合并拆分的更多相关文章

  1. VB6实现Excel多工作簿数据合并

    以前的同事,工作需要,让我帮忙完成多个工作簿的汇总. 我就用最熟悉的VB6写了一个Form应用程序,这是因为我不知道她目前的系统和Office情况,如果太高大上了,她不会部署安装.索性就简单粗暴地来个 ...

  2. 【转载】EXCEL VBA 工作表拆分

    用VBA拆分工作表是一个不错的方法,特别是在处理大量数据的时候,能节省不少时间.   1.高级筛选: 筛选并复制到新工作表的关键代码如下: Range("Database").Ad ...

  3. 我们无法找到服务器加载工作簿的数据模型"的 SharePoint 网站,当您刷新 Excel 2013 工作簿中的数据透视表时出错

    假定您使用 Analysis Services 源在 Microsoft Excel 2013 中创建数据透视表.将 Excel 工作簿上载到 Microsoft SharePoint 网站中.当您尝 ...

  4. excel破解工作簿与工作表保护

    1.工作簿保护 1.1.使用压缩文件打开文件

  5. excel vba 实现跨表单(sheet) 搜索 - 显示搜索行记录搜索历史

    前两天,一个朋友问我,有没有办法在excel里实现一个表单里是原始数据,在另一个表单里显示搜索到的行,搜索关键词可用~分隔开,并把搜索历史记录下来? 我想了想,用vba实现肯定可以啊,但是我又在想,有 ...

  6. Excel不同工作簿之间提取信息

    Sub 不同工作簿间提取信息() '用于单个字段信息的提取: Dim w As Workbook, wb1 As Workbook, wb2 As Workbook, wb3 As Workbook ...

  7. Excel统计工作簿sheet个数

    按Alt+F11调出VBE后,在"视图"-“立即窗口”中输入: debug.print ThisWorkbook.Sheets.Count 回车后就可看到工作表数量.

  8. Excel VBA基础教程

    https://www.w3cschool.cn/excelvba/excelvba-basics.html Excel VBA语言基础 VBA语言的基础认识 详解VBA编程是什么 excel处理录制 ...

  9. excel-合并多个Excel文件--VBA合并当前目录下所有Excel工作簿中的所有工作表

    在网上找EXCEL多文件合并的方法,思路: 一.Linux 或者window+cmder,直接用命令行cat合并EXCEL文件,但是,需要安装辅助东西才能直接处理(也许也不可以,但是,可以用文件格式转 ...

随机推荐

  1. 2022.9.10-2022.9.12 Java第一次课总结

    本节课中的问题总结如下: 1.Java的基本运行单位是类还是方法? 答:Java的基本运行单位是类. 2.类由什么组成? 答:类由变量/方法/属性/事件等部分组成,其中方法就是我们所熟悉的函数,属性即 ...

  2. C++面向对象编程之成员模板、模板特化、偏特化和模板模板参数

    1.成员模板 理解起来就是类是模板类,他里面的成员函数又是个模板函数 上图例子:用派生类构造父类 2.模板特化 就是在类模板泛化后写特化的类,在template<>里不绑定类型,而在类后面 ...

  3. BZOJ3732 Network(Kruskal重构树)

    Kruskal重构树的模板题. 给你N个点的无向图 (1 <= N <= 15,000),记为:1-N.图中有M条边 (1 <= M <= 30,000) ,第j条边的长度为: ...

  4. Kafka 之producer拦截器(interceptor)

    Kafka 之producer拦截器(interceptor) 一.拦截器原理 Producer拦截器(interceptor)是在Kafka 0.10版本被引入的,主要用于实现clients端的定制 ...

  5. 【C++】spdlog光速入门,C++logger最简单最快的库

    参考文档:https://spdlog.docsforge.com/master/ spdlog简介 Very fast, header only, C++ logging library. 一个he ...

  6. CSAPP实验attacklab

    attacklab 实验报告和答案文件都在 https://github.com/thkkk/attacklab

  7. NOI2011阿狸的打字机

    题目链接 昨天晚上yy出了一个做法后,感觉...好难打啊...,于是先回去休息.今天来打时,还是感觉细节好多,于是就打了两个小时.打完过了编译后,居然过了样例,直接交,尼玛居然过了???......还 ...

  8. react 可视化编辑器1

    可视化编辑器1 前言 前面我们学习低代码,例如百度的低代码平台 amis,也有相应的可视化编辑器,通过拖拽的方式生成配置文件.就像这样 笔者自己也有类似需求:比如中台有个归档需求,通过选择一些配置让后 ...

  9. python创建icon图标

    def extension_replace(path,extension): for i in range(1,len(path)): if (path[-i] == '.'): new_path = ...

  10. Mybatis-Plus多表联查

    表格结构: CREATE TABLE `ssmpdemo`.`person_test` ( `id` varchar(32) CHARACTER SET utf8 COLLATE utf8_gener ...