方案1(数据透视表实现)
“数据透视表”按指定字段统计,获得数据透视表
点击数据透视表中指定字段的值打开对应值的明细表
批量修改已打开的工作表名
Sub changename()
MsgBox “共有sheets” & Worksheets.Count & “个”
For i = 9 To (Worksheets.Count)
nname = Worksheets(i).Range(“B2”).Value ‘Range(“B2”)为要作为表名的单元格的位置
If nname <> “” Then
Worksheets(i).Name = nname
Else
MsgBox “此处为空”
Worksheets(i).Name = “default”
End If
Next
MsgBox “done!”
End Sub拆分工作表为多个工作簿(同样适用于方案二)
Sub Splitbook()
Dim xPath As String ‘工作簿所在路径
xPath = Application.ActiveWorkbook.Path ‘赋值为当前活跃工作簿所在位置
Application.ScreenUpdating = False ‘关闭更新以提高运行效率
Application.DisplayAlerts = False ‘关闭关闭excel时弹出的提示框
For Each xWs In ThisWorkbook.Sheets ‘遍历工作簿中的工作表
xWs.Copy ‘复制工作表
Application.ActiveWorkbook.SaveAs Filename:=xPath & “\” & xWs.Name & “.xls” ‘保存工作表到当前工作簿所在目录
Application.ActiveWorkbook.Close False ‘关闭工作簿但不保存
Next
Application.DisplayAlerts = True ‘恢复设置
Application.ScreenUpdating = True
End Sub
方案2(待实现.用VBA实现)
- 选取待拆分工作表中关键字列
- 创建一个字典对象,用来存储关键字值与其统计
遍历关键字列
每当有新值出现
- 在字典中插入一组键值对
- 以该值为表名在当前表之后新建一个工作表
- 同时复制当前行到新表,代码如下
'复制行到目标位置(取首个单元格即可)
sheets("oldsheet").range(cells(2,1),cells(2,lastcolumn)).copy _destination:= sheets("newsheet").range[cells(2,1)]
'获取主表最后一列非空列的列序号
lastcolumn = sheets("oldsheet").cells(2,225).end(xlToLeft).column
'获取主表最后一行非空行的行序号
lastrow = sheets("oldsheet").cells(65536,1).end(xlUP).row
遍历到的值在字典中已存在key,则对应item加1,同时复制该行到对应表的非空的最后一行之后
- 拆分单元表到单元簿(同方案1最后一步)