一需求:按照标题C的内容,一样的数据整理到一个文件中。
二.操作:
1.atl+F11弹出vb窗口
2.点击 插入===》模块 ,复制以下代码,注意这是一个表头为三行的函数(保存)
Sub 保留表头拆分数据为若干新工作簿()
Dim arr, d As Object, k, t, i&, lc%, rng As Range, c%
‘获取分割列的索引
c = Application.InputBox("刘刚:请输入拆分列号", "刘刚:输入框", 1, , , , , 1)
‘如果分割列的索引是0退出程序
If c = 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
‘取a1附近所有的数据
arr = [a1].CurrentRegion
‘取有多少列 可以将arr看做是数组,数组的第二个维度就是列的个数
lc = UBound(arr, 2)
‘取标题(从a1开始取去几行几列)(如果是一行标题,就把下行的3改成1,几行标题就写几)
Set rng = [a1].Resize(3, lc)
Set d = CreateObject("scripting.dictionary")
‘从标题行之下开始循环遍历不同的值(i = 标题行+1 如三行标题就是 4)
For i = 4 To UBound(arr)
If Not d.Exists(arr(i, c)) Then
Set d(arr(i, c)) = Cells(i, 1).Resize(1, lc)
Else
Set d(arr(i, c)) = Union(d(arr(i, c)), Cells(i, 1).Resize(1, lc))
End If
Next
k = d.Keys
t = d.Items
For i = 1 To d.Count
With Workbooks.Add(xlWBATWorksheet)
‘从哪个单元格开始复制内容
rng.Copy .Sheets(1).[a1]
‘真正的内容从标题下开始复制(4 表示标题行+1,几行标题行就改成几+1)
t(i - 1).Copy .Sheets(1).[a4]
.SaveAs Filename:=ThisWorkbook.Path & "\" & k(i - 1) & "计算机学院2019年‘劳动节‘假期学生去向登记表" & ".xls"
.Close
End With
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "成功执行"
End Sub
3.点击Excel中的文件按钮。
4.点击选项
4.自定义功能区,勾选开发工具,点击确定
5.切换到开发工具选项卡
6.点击插入,选择图片指示控件
7.随便一个位置,拖动一下,选择刚才定义的宏,确定
8.点击按钮即可
9.效果,我们输入3
10.最后的效果(同文件目录下出现拆分文件)
原文地址:https://www.cnblogs.com/bandaobudaoweng/p/10776574.html