标签：VBA，高级筛选
下图1所示是一个简单的示例数据集。这里已经突出标示了Dept A（橙色），因为这是我们可能希望为这个部门创建新工作表，然而，如果已经有一个标题为“A”的工作表，那么就不会创建新工作表，只会将数据添加到现有工作表中。其中心思想是创建一个唯一的工作表，其中包含与部门相关的数据。因此，这里会为A、B和C分别创建一个工作表。如果添加了任何新的部门，则也为这些部门创建新的工作表。
图1
这将有效地使代码更长一些，因为需要对此进行测试，但它工作得很好。
下面的VBA代码有两个作用，它首先创建一个唯一列表，然后基于该唯一列表使用高级筛选。高级筛选是一个很好的工具，因为它可以在不使用复制和粘贴的情况下完成上述操作。它可以轻松地在工作表之间移动数据，而且速度非常快。
Sub AdvFilt()
Dim i As Integer
Dim sh As Worksheet
Set sh = Sheet1 '主工作表
sh.[A1:A3000].AdvancedFilter 2, sh.[M1], , 1 '唯一值
For i = 2 To sh.Range("M" & Rows.Count).End(xlUp).Row
sh.[N2] = sh.Range("M" & i)
If Not Evaluate("ISREF('" & CStr(sh.Range("M" & i)) & "'!A1)") Then
Sheets.Add(After:=Sheets(Worksheets.Count)).Name = sh.[N2]
sh.[A1].CurrentRegion.AdvancedFilter 2, sh.[N1:N2], Sheets(CStr(sh.[N2])).[A1]
End If
Sheets(CStr(sh.[N2])).[A1].CurrentRegion.ClearContents
sh.[A1].CurrentRegion.AdvancedFilter 2, sh.[N1:N2], Sheets(CStr(sh.[N2])).[A1]
Next i
sh.Range("M1:M400, N2").ClearContents
sh.Select
End Sub
这段代码首先创建唯一值列表：
sh.[A1:A3000].AdvancedFilter 2, sh.[M1], , 1
这里只是选择了前3000行，而不是创建一个动态列表。高级筛选将列出唯一值项，并将其放在M列中。
接下来，代码需要循环遍历该唯一列表，这里使用了一个简单的For循环，从第2行循环到M列中最后使用的行。
For i = 2 To sh.Range("M" & Rows.Count).End(xlUp).Row
下一步是检查工作表是否存在，这可以在不循环工作表的情况下有效地执行此操作。
If Not Evaluate("ISREF('" & CStr(sh.Range("M" & i)) & "'!A1)") Then
接下来的两个步骤是清除内容并添加数据。
Sheets(CStr(sh.[N2])).[A1].CurrentRegion.ClearContents
sh.[A1].CurrentRegion.AdvancedFilter 2, sh.[N1:N2], Sheets(CStr(sh.[N2])).[A1]
最后进行了一点整理，代码完成。
上面的代码运行得非常顺利，并在过程运行完毕后清除了一些辅助信息。注意，在单元格N1输入有部门名称，这需要保留，因为高级筛选需要标题。
注：本文学习整理自thesmallman.com，有兴趣的朋友可以到该网站下载原示例工作簿，也可以到知识星球App完美Excel社群下载中文示例工作簿。
