按照某列将一张工作表拆分到多个工作表,这是一个很实用的技巧。
比如:已经计算好的各地区的销售明细,怎么按照地区拆分到各个工作表中?
如果会使用VBA的同学,一键就能生成
不使用VBA,还能做吗?
利用透视表按照关键字段就可以拆分
辅助列用鼠标拖拉到'筛选'区域,其他列都拖拉到'行'区域
按下图设置报表布局,并禁用分类汇总和总计
菜单选择'分析'-'选项'-'显示筛选页'
并按Shift选择工作表,把表格都转成数值。
用'显示报表筛选页'功能,便可拆分到多张工作表。
操作很简单,练几次就可以上手了。
如果想灵活选择某列或一键生成,当然是选择VBA。
两者各有优点,下面附上通用的拆分代码,供大家学习。
按Alt+F11,插入模块,把代码粘贴到模块中
Sub 按指定列分组拆分数据()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sh = ActiveSheet
For i = Sheets.Count To 1 Step -1
If Sheets(i).Name <> sh.Name Then
Sheets(i).Delete
End If
Next i
Dim splitColumnRange As Range
Set splitColumnRange = Application.InputBox(prompt:='请选择拆分的列:选择任何一个该列的单元格即可', Type:=8)
Dim columnNumToSplit As Long
n = splitColumnRange.Column
Set Rng = splitColumnRange.CurrentRegion
arr = Rng
Rng.Sort Key1:=Rng(1, n), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1
brr = Rng(1, 1).Resize(UBound(arr) + 1, UBound(arr, 2))
ReDim crr(1 To UBound(brr), 1 To UBound(brr, 2))
x = 1
For i = 2 To UBound(brr) - 1
x = x + 1
For j = 1 To UBound(brr, 2)
brr(x, j) = brr(i, j)
Next
If brr(i, n) <> brr(i + 1, n) Then
Set sht = Sheets.Add(after:=Sheets(Sheets.Count))
sht.Name = brr(i, n)
sht.Range('a1').Resize(x, UBound(brr, 2)) = brr
x = 1
End If
Next
splitColumnRange.CurrentRegion = arr
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
好了,今天就分享到这,有问题可以给我留言。
联系客服