前面我们已经掌握了单元格、工作表、按钮关联宏的使用今天我们就做一个综合案例

做案例之前我们先补充一点新知识

• Cells(2,3) //表示两行三列的单元格
• Range(“a1”).offset(1,2) // 下移一行，右移2行
• Range(“a10”).end(xlup) //从a10往上数，有多少行已用
• Range(“a10”).entirerow //选中a10的整行
• Range(“a10”).resize(1,10) //重选区域
• Range(“a10”).copy //复制
• sheet1.Range("a:f").AutoFilter field:=4, Criteria1:="一车间" //'在sheet1中筛选第四列为一车间的数据。其中field是第x列，Criteria1是筛选条件。注意Criteria1最后一个是数字1

案例

题目：

excel将下面叫做“数据”的工作表根据分类条件拆分成多个sheet工作表，表名为分类条件。

结果如下：

分析：

1. 要新建所有分类表，在总表中循环每行，把要筛选的列值作为新建的表名， 每次循环要判断是否已存在表名，重复建表会报错
2. 删除多余的表，不然每次执行会产生很多表比较混乱
3. 需要筛选拷贝数据。

注意：执行这段代码前必须选中总表即你要拆分的表，否则数据会遭到破坏

代码：

Sub chaifen()
  Dim i As Integer
    Dim j, k, irow, count As Integer
    Dim sht  As Worksheet
    Dim sht1  As Worksheet
    Dim x As Integer
    Dim sht0  As Worksheet

    Set sht0 = ActiveSheet
    
    x = InputBox("请选择你要按哪列分，第几列就填几")
    
    '执行分表前删除多余的表
    Application.DisplayAlerts = False
    If Sheets.count > 1 Then
        For Each sht1 In Sheets
            If sht1.Name <> sht0.Name Then
             sht1.Delete
             End If
        Next
        
    End If
    
    Application.DisplayAlerts = True
    
    
    '获取sheet1总行数
    irow = sht0.Range("a65536").End(xlUp).Row
    
     For i = 2 To irow
     '初始化k
        k = 0
        For Each sht In Sheets
        '判断是否已存在表名
            If sht.Name = sht0.Cells(i, x) Then
            k = 1
            End If
        Next
        '如果不存在表名就新建一个表
        If k = 0 Then
            Sheets.Add after:=Sheets(Sheets.count)
            Sheets(Sheets.count).Name = sht0.Cells(i, x)
        End If
        '筛选拷贝数据
         For j = 2 To Sheets.count
            sht0.Range("a1:f" & irow).AutoFilter field:=x, Criteria1:=Sheets(j).Name
            sht0.Range("a1:f" & irow).Copy Sheets(j).Range("a1")
            '关闭筛选
            sht0.Range("a1:f" & irow).AutoFilter
         Next
        
    Next
    sht0.Select
    
 End Sub

注意：执行这段代码前必须选中总表即你要拆分的表，否则数据会遭到破坏

这段案例代码的知识点有：

1. Set sht0 = ActiveSheet
2. irow = sht0.Range("a65536").End(xlUp).Row
3. Sheets(Sheets.count).Name = sht0.Cells(i, x）
4. sht0.Range("a1:f"&irow).AutoFilter field:=x, Criteria1:=Sheets(j).Name
5. sht0.Range("a1:f" & irow).Copy Sheets(j).Range("a1")

看了这篇文章觉得对你有用的话，关注我的公众号“学会数据分析”并且用你的小手帮忙分享一下。

我会经常总结一些案例和大家一些分享。

课件下载地址：

链接永久有效:

https://pan.baidu.com/s/1gAmb-z84vLh7u6X2mFY12Q

提取码: t1km 复制这段内容后打开百度网盘手机App，操作更方便哦