如何用VBA按要求分工作表

chandelier9638

本人小白一枚，由于每月分表工作量就很大，所以向大神们请教，表中A2：A5都有数据，A2=“铁制品”，如何运用VBA新增加一个名称为“铁制品的”工作表？

jiangxiaoyun

其实可以用   数据透视表--显示筛选项

chandelier9638

jiangxiaoyun 发表于 2018-7-14 09:26
其实可以用   数据透视表--显示筛选项

太强大了，数据透视表居然还有这种操作？

lsc900707

1. Sub abc()
   
2.     arr = [a1].CurrentRegion
   
3.     For i = 2 To UBound(arr)
   
4.         Sheets.Add(after:=Sheets(1)).Name = arr(i, 1)
   
5.     Next
   
6. End Sub

复制代码

lsc900707

附件供测试参考：

jiangxiaoyun

Sub ff()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    With Sheets("总表")
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            If SheetExists(.Cells(i, 1).Value) = False Then
                Sheets.Add.Name = .Cells(i, 1).Value
            End If
        Next
    End With
End Sub
Function SheetExists(sname) As Boolean
    '   判断活动工作簿中某个工作表是否存在，例如，【SheetExists("小明"),返回True表示存在】【SheetExists("小"),返回False表示不存在】
    Dim x As Object
    On Error Resume Next '根据错误判断工作表是否存在，如果存在则不报错，反之报错
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True _
    Else SheetExists = False
End Function

chandelier9638

jiangxiaoyun 发表于 2018-7-14 09:51
Sub ff()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

请教大神，假如内容有重复，这个代码就不能用了吗？

chandelier9638

lsc900707 发表于 2018-7-14 09:46

请假大神，假如内容重复了，这个代码就不能用了吗？

lsc900707

chandelier9638 发表于 2018-7-14 10:56
请假大神，假如内容重复了，这个代码就不能用了吗？

当然，所以你举例时要尽量穷尽各种可能。

chandelier9638

lsc900707 发表于 2018-7-14 10:58
当然，所以你举例时要尽量穷尽各种可能。

看来我还是想得不够周全，其实之前我是用删除重复项筛出唯一值，再一个个分表，然后再用数组公式引用总表的内容到各个分表里面的，用VBA实现数据引用一步我已经做到了，请问老师，能否用代码先把这一类数据筛选出重复项后再分表？