版权声明:本文为博主原创文章,未经博主允许不得转载。 https://blog.csdn.net/kese7952/article/details/80282484
课件下载 :
方式1:本节课件下载地址 链接: https://pan.baidu.com/s/1pzBvCMOcG0Mnzr0IFj7LlQ 密码: u9pk
方式2:或点击此处下载
效果图
代码示例:
Sub chaifenshuju()
Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer '这个说的是一共多少行
Dim l As Integer
l = InputBox("请输入你要按哪列分")
'删除无意义的表
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
For Each sht1 In Sheets
If sht1.Name <> "数据" Then
sht1.Delete
End If
Next
End If
Application.DisplayAlerts = True '这个地方上课的时候我没改成true,请大家注意一下
irow = Sheet1.Range("a65536").End(xlUp).Row
'拆分表
For i = 2 To irow
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Cells(i, l) Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Cells(i, l)
End If
Next
'拷贝数据
For j = 2 To Sheets.Count
Sheet1.Range("a1:f" & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name
Sheet1.Range("a1:f" & irow).Copy Sheets(j).Range("a1")
Next
Sheet1.Range("a1:f" & irow).AutoFilter
Sheet1.Select
MsgBox "已处理完毕"
End Sub
作者: 杨校
出处: https://blog.csdn.net/kese7952
分享是快乐的,也见证了个人成长历程,文章大多都是工作经验总结以及平时学习积累,基于自身认知不足之处在所难免,也请大家指正,共同进步。
本文版权归作者所有,欢迎转载,但未经作者同意必须保留此段声明,且在文章页面明显位置给出, 如有问题, 可邮件(397583050@qq.com)咨询。