excel将一个工作表根据条件拆分成多个sheet工作表与合并多个sheet工作表
本例介绍在excel中如何将一个工作表根据条件拆分成多个工作表。 注意:很多朋友反映sheets(i).delete这句代码出错,要注意下面第一个步骤,要拆分的数据工作表名称为“数据源”, 而不是你新建工作簿时的sheet1这种。手动改成“数据源”即可。或者是把代码中得"数据源"改为你得源工作表“Sheet1”也行
Sub CFGZB() Dim myRange As Variant Dim myArray Dim titleRange As Range Dim title As String Dim columnNum As Integer myRange = Application.InputBox(prompt:="请选择标题行:", Type:=) myArray = WorksheetFunction.Transpose(myRange) Set titleRange = Application.InputBox(prompt:="请选择拆分的表头,必须是第一行,且为一个单元格,如:“姓名”", Type:=) title = titleRange.Value columnNum = titleRange.Column Application.ScreenUpdating = False Application.DisplayAlerts = False Dim i&, Myr&, Arr, num& Dim d, k For i = Sheets.Count To Step - If Sheets(i).Name <> "Sheet1" Then
Sheets(i).Delete End If Next i Set d = CreateObject("Scripting.Dictionary") Myr = Worksheets("Sheet1").UsedRange.Rows.Count Arr = Worksheets("Sheet1").Range(Cells(, columnNum), Cells(Myr, columnNum)) For i = To UBound(Arr) d(Arr(i, )) = "" Next k = d.keys For i = To UBound(k) Set conn = CreateObject("adodb.connection") conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName Sql = "select * from [Sheet1$] where " & title & " = '" & k(i) & "'" Worksheets.Add after:=Sheets(Sheets.Count) With ActiveSheet .Name = k(i) For num = To UBound(myArray) .Cells(, num) = myArray(num, ) Next num .Range("A2").CopyFromRecordset conn.Execute(Sql) End With Sheets().Select Sheets().Cells.Select Selection.Copy Worksheets(Sheets.Count).Activate ActiveSheet.Cells.Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Next i conn.Close Set conn = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
1.将要合并的文件放在同一文件夹下,复制过来就好(ps:最好不要直接操作原数据文件,避免操作失败,数据丢失)
2.在这个目录下创建一个“合并.xlsx”
3.双击打开“合并.xlsx”
4.同时按 ALT + F11
Option Explicit Sub mergeonexls() '合并多工作簿中指定工作表 On Error Resume Next Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet Dim t As Workbook, ts As Worksheet, l As Integer, h As Long Application.ScreenUpdating = False Application.DisplayAlerts = False x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", Title:="Excel选择", MultiSelect:=True) Set t = ThisWorkbook Set ts = t.Sheets(1) '指定合并到的工作表,这里是第一张工作表 l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column For Each x1 In x If x1 <> False Then Set w = Workbooks.Open(x1) Set wsh = w.Sheets(1) '指定所需合并工作表,这里是第一张工作表 h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then wsh.UsedRange.Copy ts.Cells(1, 1) Else wsh.UsedRange.Copy ts.Cells(h + 1, 1) End If w.Close End If Next Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Sub mergeeveryonexls() '将多个工作簿下的工作表依次对应合并到本工作簿下的工作表,即第一张工作表对应合并到第一张,第二张对应合并到第二张…… On Error Resume Next Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet Dim t As Workbook, ts As Worksheet, i As Integer, l As Integer, h As Long Application.ScreenUpdating = False Application.DisplayAlerts = False x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", Title:="Excel选择", MultiSelect:=True) Set t = ThisWorkbook For Each x1 In x If x1 <> False Then Set w = Workbooks.Open(x1) For i = 1 To w.Sheets.Count If i > t.Sheets.Count Then t.Sheets.Add After:=t.Sheets(t.Sheets.Count) Set ts = t.Sheets(i) Set wsh = w.Sheets(i) l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then wsh.UsedRange.Copy ts.Cells(1, 1) Else wsh.UsedRange.Copy ts.Cells(h + 1, 1) End If Next w.Close End If Next Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
来源:https://blog.csdn.net/qq_38545713/article/details/82500483
excel将一个工作表根据条件拆分成多个sheet工作表与合并多个sheet工作表的更多相关文章
- 【linux应用】将一个大文件按行拆分成小文件
例如将一个BLM.txt文件分成前缀为 BLM_ 的1000个小文件,后缀为系数形式,且后缀为4位数字形式 先利用 wc -l BLM.txt #读出BLM.txt有多少行. 再利用 split 命令 ...
- WPS 2019 多个sheet表拆分成独立的excel文件
参考: https://www.cnblogs.com/hackxiyu/p/8945975.html 场景:将多个sheet表拆分成独立的excel文件 一.安装VB工具: 默认情况下:wps -- ...
- 个人永久性免费-Excel催化剂功能第48波-拆分工作薄内工作表,堪称Excel界的单反
一个工作薄有多个相同类型的工作表,然后想通过批量操作,把每个工作表都另存为一个工作薄文件,这个批量拆分工作薄,绝大多数插件都有此功能,就如懂点VBA的高级用户也常常有点不屑于用插件来完成,自己写向行V ...
- 将excel按照某一列拆分成多个文件(方案整理)
1解决方案:将excel按照某一列拆分成多个文件 https://blog.csdn.net/ntotl/article/details/79141314 2遇到的问题:解决vbe6ext.olb不能 ...
- sql 表值函数-将一个传入的字符串用2中分隔符拆分成临时表
USE [tms]GO/****** Object: UserDefinedFunction [dbo].[fn_StrToTable_Double] Script Date: 2017/4/26 9 ...
- sqlserver 将 “用 特定字符 分隔的一个字段” 拆分成多个字段,然后两个表之间数据更新
将源TXT文件sourceFile_table.txt导入数据库,生成新表dbo.sourceFile_table.新增字段lon.lat.shi.xian 源表dbo.sourceFile_tabl ...
- 正整数n拆分成几个不同的平方数——DFS&&打表
考虑将正整数n拆分成几个不同的平方数之和,比如30=1^2 + 2^2 + 5^2=1^2 + 2^2 + 3^2 + 4^2,而8不存在这样的拆分. #include<bits/stdc++. ...
- 把sql server 2000的用户表的所有者改成dbo
怎么样把sql server 2000的用户表的所有者,改成dbo,而不是用户名. 推荐使用下面介绍的第二种方法,执行以下查询便可以了.sp_configure 'allow updates','1' ...
- mysql关于数据库表的水平拆分和垂直拆分
最初知道水平垂直分表的时候是刚参加工作不久的时候,知道了这个概念,但是公司用户量和数据量始终没上来,所以也没用到过,知道有一天到了一家新公司后,这些才被应用到实际开发中,这里我就大概说说关于水平和垂直 ...
随机推荐
- [LeetCode] 88. Merge Sorted Array 合并有序数组
Given two sorted integer arrays nums1 and nums2, merge nums2 into nums1 as one sorted array. Note: T ...
- [LeetCode] 712. Minimum ASCII Delete Sum for Two Strings 两个字符串的最小ASCII删除和
Given two strings s1, s2, find the lowest ASCII sum of deleted characters to make two strings equal. ...
- C1128节数超过对象文件格式限制: 请使用 /bigobj 进行编译
今天debug C++项目是遇到 解决方案: 右键项目—>属性 输入 /bigobj 再次编译问题解决
- Windows快捷键大全
每天在使用电脑,不会记点快捷键怎行?高效办公从快捷键开始! Windows 10 键盘快捷方式就是按键或按键组合,可提供一种替代方式来执行通常使用鼠标执行的操作. 其他键盘快捷方式 应用中的键盘快捷方 ...
- 创建 django 项目命令
创建Django项目 django-admin startproject HelloWorld Django创建app cd HelloWorld python manage.py startapp ...
- [转帖]Helm V2 迁移到 V3 版本
Helm V2 迁移到 V3 版本 -- :: Mr-Liuqx 阅读数 63更多 分类专栏: kubernetes 版权声明:本文为博主原创文章,遵循 CC 4.0 BY-SA 版权协议,转载请附上 ...
- 基于OpenCV制作道路车辆计数应用程序
基于OpenCV制作道路车辆计数应用程序 发展前景 随着科学技术的进步和工业的发展,城市中交通量激增,原始的交通方式已不能满足要求:同时,由于工业发展为城市交通提供的各种交通工具越来越多,从而加速了城 ...
- Roads in the Kingdom CodeForces - 835F (直径)
大意: 给定一个基环树, 求删除一条环上的边使得直径最小. 直径分两种情况 环上点延伸的树内的直径 两个环上点的树内深度最大的点匹配 第一种情况直接树形dp求一下, 第二种情况枚举删除的环边, 线段树 ...
- JavaNetty心跳监控
import java.net.InetAddress; import java.net.UnknownHostException; import java.util.Map; import java ...
- oracle数据库 部分函数的用法
select * from tab; //获取当前用户的数据库的所有表名 select sys_guid(),UserName from TESTLIKUI; //获取guid select sys_ ...