excel将一个工作表根据条件拆分成多个工作表
来源:网络收集 点击: 时间:2024-08-02原始数据表如下(名称为:数据源),需要根据B列人员姓名拆分成每个人一个工作表。

点击【开发工具】-【Visual Basic】或者Alt+F11的快捷键进入VBE编辑界面。

如下图所示插入一个新的模块。


如下图,粘贴下列代码在模块中:
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:=8)
myArray = WorksheetFunction.Transpose(myRange)
Set titleRange = Application.InputBox(prompt:=请选择拆分的表头,必须是第一行,且为一个单元格,如:“姓名”, Type:=8)
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 1 Step -1
If Sheets(i).Name 数据源 Then
Sheets(i).Delete
End If
Next i
Set d = CreateObject(Scripting.Dictionary)
Myr = Worksheets(数据源).UsedRange.Rows.Count
Arr = Worksheets(数据源).Range(Cells(2, columnNum), Cells(Myr, columnNum))
For i = 1 To UBound(Arr)
d(Arr(i, 1)) =
Next
k = d.keys
For i = 0 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 where title = k(i)
Worksheets.Add after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = k(i)
For num = 1 To UBound(myArray)
.Cells(1, num) = myArray(num, 1)
Next num
.Range(A2).CopyFromRecordset conn.Execute(Sql)
End With
Sheets(1).Select
Sheets(1).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

如下图所示,插入一个控件按钮,并指定宏到刚才插入的模块代码。


点击插入的按钮控件,根据提示选择标题行和要拆分的列字段,本例选择“姓名”字段拆分,当然也可以选择C列的“名称”进行拆分,看实际需求。




代码运行完毕后在工作簿后面会出现很多工作表,每个工作表都是单独一个人的数据。具体如下图所示:

注意:
1)原始数据表要从第一行开始有数据,并且不能有合并单元格;
2)打开工作簿时需要开启宏,否则将无法运行代码。
注意事项如果您觉得此经验有用,可以点击本页面右上方的【大拇指】图案和【收藏按钮】或者右下方的【分享】按钮,也可以点击本注意事项下方的【收藏】按钮。
如需要了解更多内容,可以百度搜索“百度经验shaowu459”或到百度知道向我提问。
excel工作表版权声明:
1、本文系转载,版权归原作者所有,旨在传递信息,不代表看本站的观点和立场。
2、本站仅提供信息发布平台,不承担相关法律责任。
3、若侵犯您的版权或隐私,请联系本站管理员删除。
4、文章链接:http://www.1haoku.cn/art_1054121.html