拆分sheet和合并sheet

1.拆分sheet
按照某列拆分sheet两种形式：
（1）数据透视表：
选定本工作表区域
筛选器：待分类列；行分类：剩下列
设置：数据透视表工具设计中选择：
分类汇总：不显示分类汇总
总计：对行和列禁用
报表布局：以表格形式显示
拆分：全选数据透视表数据，选项中选择显示报表筛选项，确定
（2）VBA方式

#分类拆分sheet.name需要修改为当前表的名字
#第一个弹框选择表头
#第二个弹框选择分类列名
Sub chaifen()
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

2.合并工作表

##该代码适用于A列最后一行有值，获取汇总表已使用单元格行数时最好使用必填单元格，否则可能会出现覆盖的情况
##若每个工作表都有表头，则表头会出现重复
##第一行会存在空行，是由获取下一行造成的
Sub Merge() '工作簿内合并所有工作表
Dim sheetsCount As Long '当前工作表数量
Dim rowCount As Long '汇总后表行数
Dim i As Long '循环i次
With ThisWorkbook
sheetsCount = .Sheets.Count '获取当前工作表数量
.Sheets.Add After:=.Sheets(.Sheets.Count) '新建一个工作表
.Sheets(.Sheets.Count).Name = "汇总" '新建工作表名汇总
For i = 1 To sheetsCount
.Sheets(i).UsedRange.Copy '逐个循环复制表内
With .Sheets("汇总")
rowCount = .Range("B" & 2 ^ 20).End(xlUp).Row + 1 '获取汇总表下一行行数，B列值不为空，选择B列作为计算列
.Range("A" & rowCount).Select '选中A列该行所在单元格
.Paste '粘贴
End With
Next
.Sheets("汇总").Move before:=.Sheets(1) '移动汇总表
End With
End Sub

最后

以上就是鲜艳苗条为你收集整理的拆分sheet和合并sheet的全部内容，希望文章能够帮你解决拆分sheet和合并sheet所遇到的程序开发问题。

如果觉得靠谱客网站的内容还不错，欢迎将靠谱客网站推荐给程序员好友。