【VBA】Excel根据指定字段自动分页sheet功能的实现

1.背景

业务方提了个需求，一个excel的明细宽表，需要根据指定的字段（字段不确定），将宽表分成多个sheet便于在不影响源数据的情况下，可以根据多个公司、部门、实现内容分发；

2.演示过程

vba_excel自动分页工具模板

3.vb代码实现

**实现思想：**在代码中，一般通过循环遍历指定值，即可实现，但如果不同场景需要频繁调整值的情况下，也是麻烦的事，所以用vba实现excel脚本。

Sub 分页()
'
Application.DisplayAlerts = False
Set sht = ActiveSheet

'选中筛选单元格
Set rg = Application.InputBox("请选择要筛选的列的首行单元格", "一键分页", , , , , , 8)

'获取表格边界
r = rg.End(2).Column
If r = 16384 Then r = rg.Column
u = rg.Row
d = rg.End(4).Row
l = rg.End(1).Column

If l = 1 And Cells(l, u).Value = "" Then
    l = rg.Column
Else
    l = l
End If

F = rg.Column - l + 1

'开始除重
Range(Cells(u + 1, rg.Column).Address & ":" & Cells(d, rg.Column).Address).Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "除重用"

ActiveSheet.Paste
Application.CutCopyMode = False
Selection.RemoveDuplicates Columns:=1, Header:=xlNo
comp_cnt = Sheets("除重用").Cells(1, 1).End(4).Row



For i = 1 To comp_cnt
    comp = Sheets("除重用").Cells(i, 1).Value
    sht.Range(Cells(u, l).Address() & ":" & Cells(d, r).Address()).AutoFilter Field:=F, Criteria1:=comp
    sht.Select
    sht.Range(Cells(u, l).Address() & ":" & Cells(d, r).Address()).Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = comp
    ActiveSheet.Paste
Next

Sheets("除重用").Delete
Application.DisplayAlerts = True
sht.Select
rg.Select
Selection.AutoFilter
End Sub

4.总结

以上是总结VB实现Excel根据指定字段自动分页sheet功能的过程，希望能帮到大家， 如有错误，欢迎指正。
原创不易，转载请注意出处：
https://blog.csdn.net/weixin_41613094/article/details/129614458?spm=1001.2014.3001.5501