拆分表格并保存

函数
- Application主程序对象
- Open 打开文件
- Add 新建工作簿
- Merge合并
- AutoFilter(自动筛选)
- Offset 偏移
- Msgbox和Inputbox窗口函数
练习
- 拆分表存储成文件
- 合并单元格
- 利用筛选分离表格内容
- 按照a1建表（避免重复名字）
- 填充数据到指定表格里
- 将数据表单元格创建分表再填充数据
综合训练
- 利用窗口函数吧上面的动作重新来一遍
- 把分表内容整合到sht1

函数

Application主程序对象

application.displayalsert=false 表示不要弹窗

Open 打开文件

eg ：

application screenupdating=false//不要屏幕更新
Workbooks. Open Filename:="d:\data\1.xlsx"
activeworkbook.sheets(1).range("a1") = "lala"//表示打开当前文件输入的标记
activeworkbook.save
activeworkbook.close
application.displayalsert=true

Add 新建工作簿

eg:

Sub one()
Workbooks.Add
ActiveWorkbook.Sheets(1).Range("a1") = "llll"
ActiveWorkbook.SaveAs Filename:="C:\Users\zsnzd\Desktop\excel\第四节\22.xlsx"
ActiveWorkbook.CloseEnd Sub

range（“范围”）
**Save/Save as 保存工作簿
Close关闭工作簿
Select(选中)
Delete(删除)
Copy(复制)
ClearContents(清空)
Value(值) Text(内容文字)
Row(行号) Column(列号)
Entirerow单元格所在整行 **

Merge合并

AutoFilter(自动筛选)

Offset 偏移

新建表时回避重名错误

Msgbox和Inputbox窗口函数

Sub chuan()Msgbox "你好"m = InputBox("请输入第" & m & "例")
End Sub

练习

拆分表存储成文件

注意i容易出错

Sub chaifen()
Dim sht As Worksheet
Dim i As Integer
For Each sht In Sheetssht.CopyActiveWorkbook.SaveAs Filename:="C:\Users\zsnzd\Desktop\excel\第四节\" & sht.Name & ".xlsx"ActiveWorkbook.CloseNext
Application.DisplayAlerts = True
End Sub

结合上一讲综合练习

//删除空格，填充
Sub shaixuan()
Dim sht As Worksheet
Dim i As IntegerFor Each sht In SheetsFor i = 100 To 2 Step -1If sht.Cells(i, 4) = "" Thensht.Range("d" & i).EntireRow.DeleteEnd IfIf sht.Cells(i, 2) = "理工" Thensht.Cells(i, 3) = "lg"ElseIf sht.Cells(i, 2) = "文科" Thensht.Cells(i, 3) = "wg"Elsesht.Cells(i, 3) = "ck"End IfIf sht.Cells(i, 5) = "男" Thensht.Cells(i, 6) = "先生"Elsesht.Cells(i, 6) = "女士"End IfNextNextEnd Sub//拆成文件
Sub chai()
Dim sht As Worksheet
For Each sht In Sheetssht.CopyActiveWorkbook.SaveAs Filename:="C:\Users\zsnzd\Desktop\excel\第四节\" & sht.Name & ".xlsx"ActiveWorkbook.Close
Next
Application.DisplayAlerts = True
End Sub

合并单元格

利用筛选分离表格内容

**注意
1、end后面的row
2、k是整数型
3、range（“a1：f”&k）
4、copy后面直接加sht.单元格
5、Criteria1:="=" 这里是one
**

Sub 用筛选拆分()
Dim i As Integer
Dim sht As Worksheeti = Sheet1.Range("a65535").End(xlUp).Row
For Each sht In WorksheetsIf sht.Name <> 数据 ThenSheet1.Range("a1:f" & i).AutoFilter field:=4, Criteria1:="=" & sht.NameSheet1.Range("a1:f" & i).Copy sht.Range("a1")End If
NextSheet1.Range("a1:f" & i).AutoFilter
End Sub

按照a1建表（避免重复名字）

**注意：
1、i表示对行的循环整数
2、k表示布尔值判断作用
3、所有表的后面建sheets.add after:=
**

Sub bimian()
Dim sht As Worksheet
Dim i As Integer
Dim k As Integer
For i = 1 To Sheet1.Range("a65536").End(xlUp).Rowk = 0For Each sht In SheetsIf sht.Name = Sheet1.Range("a" & i) Thenk = 1End IfNextIf k = 0 ThenSheets.Add after:=Sheets(Sheets.Count)Sheets(Sheets.Count).Name = Sheet1.Range("a" & i)End If
Next
End Sub

填充数据到指定表格里

Sub chai()
Dim sht As Worksheet
Dim k As Integer
k = Sheet1.Range("a65536").End(xlUp).Row
For Each sht In Sheets
If sht.Name <> 数据 ThenSheet1.Range("a1:f" & k).AutoFilter field:=4, Criteria1:="=" & sht.NameSheet1.Range("a1:f" & k).Copy sht.Range("a1")
Next
Sheet1.Range("a1:f" & k).AutoFilter
End Sub

将数据表单元格创建分表再填充数据

Sub chai()
Dim sht As Worksheet
Dim k, i, j As Integer
k = Sheet1.Range("a65536").End(xlUp).Row
'拆分
For i = 2 To kj = 0For Each sht In WorksheetsIf sht.Name = Sheet1.Range("d" & i) Thenj = 1End IfNextIf j = 0 ThenSheets.Add after:=Sheets(Sheets.Count)Sheets(Sheets.Count).Name = Sheet1.Range("d" & i)End If
Next'填数据
For Each sht In WorksheetsIf sht.Name <> 数据 ThenSheet1.Range("a1:f" & k).AutoFilter field:=4, Criteria1:="=" & sht.NameSheet1.Range("a1:f" & k).Copy sht.Range("a1")End If
NextSheet1.Range("a1:f" & k).AutoFilter
End Sub

综合训练

利用窗口函数吧上面的动作重新来一遍

Sub chai()
Dim sht As Worksheet
Dim k, i, j As Integer
k = Sheet1.Range("a65536").End(xlUp).Row
Msgbox "你好"
m = InputBox("请输入一个" & m & "列")
'拆分
For i = 2 To kj = 0For Each sht In WorksheetsIf sht.Name = Sheet1.Range("d" & i) Thenj = 1End IfNextIf j = 0 ThenSheets.Add after:=Sheets(Sheets.Count)Sheets(Sheets.Count).Name = Sheet1.Range("d" & i)End If
Next'填数据
For Each sht In WorksheetsIf sht.Name <> 数据 ThenSheet1.Range("a1:f" & k).AutoFilter field:=m, Criteria1:="=" & sht.NameSheet1.Range("a1:f" & k).Copy sht.Range("a1")End If
NextSheet1.Range("a1:f" & k).AutoFilter
End Sub

把分表内容整合到sht1

注意
1、清空内容要指定range范围

Sub hebing()
Dim i, j As Integer   //i是数据源表的最后一行，j是目标表(数据表)的最后一行
Dim sht As Worksheet//先要删除所有数据
Sheet1.Range("a1:f65536").ClearContents//复制表头
Sheet2.Range("a1:f1").Copy Sheet1.Range("a1")//复制数据
For Each sht In SheetsIf sht.Name <> "数据" Theni = sht.Range("a65536").End(xlUp).Rowj = Sheet1.Range("a65536").End(xlUp).Rowsht.Range("a2:f" & i).Copy Sheet1.Range("a" & j + 1)End If
Next
End Sub

【excel vba】拆分表格相关推荐

excel如何拆分表格
今天跟大家分享一下excel如何拆分表格 1.打开演示文件,要求将表格拆分为多个工作表. 2.首先我们点击下图选项 3.点击[汇总拆分]选择[拆分工作表] 4.将[表头行数]设置为2 5.最后点击[确 ...
excel如何拆分表格？
今天跟大家分享一下excel如何拆分表格? 1.打开演示文件,要求将表格按照店铺的不同分别拆分开. 2.首先我们点击下图选项 3.点击[汇总拆分]-[拆分工作表] 4.将[表头行数]设置为2 5.然后 ...
excel如何拆分表格为多个
今天跟大家分享一下excel如何拆分表格为多个 1.打开演示文件,要求将表格按照管区的不同拆分为多个. 2.首先我们点击下图选项 3.点击[汇总拆分]-[拆分工作表] 4.将[表头行数]设置为3 5. ...
VB实现excel自动拆分表格
工作场景:从系统导出后人工处理完的excel数据,需要按照部门拆分并推送给各部门人员. 传统的工作方式就只能人工一个个部门筛选,复制粘贴出来各自发送. 其实现在有些版本的excel或wps已经集成了根 ...
excel怎么拆分表格
1.如下图是某公司几个分公司产品生产情况,现在想要按照分公司的不同快速将表格拆分为多个. 2.点击下图选项(Excel工具箱,百度即可了解详细下载安装信息,本文这里就不做详细解说.) 3.点击[汇 ...
excel怎么拆分表格之按照关键词拆分表格数据
1.如下图是某公司出库表,现在我们想要将此表格按照业务部门关键词将表格数据拆分掉. 2.首先我们点击下图选项 3.点击[汇总拆分],选择[拆分工作表] 4.然后将[表头行数]设置为1 5.将[关键 ...
3, excel vba 获取表格里的单元格的值
通过上一节, 我们己经可以掌握进入vba的编辑页面,可以愉快的写代码了. 接下来,给大家看看怎么取得表格里一个单元格的值.因为只有拿到了这个值,你才能对它进行各种改造如下图: 单元格 A1 里有一个 ...
Excel Vba拆分并填充单元格
https://www.cnblogs.com/icedream/archive/2013/03/05/2945158.html Sub 拆分并填充单元格() ' ' 拆分并填充单元格宏 ' ' 可 ...
04 excel vba 在表格的底部输入学生姓名和成绩
自动弹出输入姓名和成绩的输入框,并且直接在表格底部输入姓名和成绩用到了表格两个命令 : end(xlDown)移动表格最后一行 Offset(1,0) 下面一行的单元代码如下: '出错提醒 Op ...
Excel vba开发合并单元格拆分自动填充功能、在每一条数据后面插入空白行、将地理坐标的经纬度转换成度等功能
写在前面: 最近老大丢给我一个数据量比较大,比较复杂的表,让我用VB去处理,刚被分到这个任务的时候一脸茫然,对Excel VB开发一点都不了解,所以就自己研究并查资料,最后终于解决了. 一.Excel ...

【excel vba】拆分表格