如何根据某一列的过滤创建多个 Excel 工作表？

Question

我有以下数据：

Name    Year    Sales
Ratata  2012    10000
Pikachu 2013    20000
Akens   2014    30000
Zubat   2012    40000
Onyx    2014    30000
Snorlax 2014    20000

我想要表格中每一年的新工作表。在此示例中，我将期望 3 个新工作表 - 2012、2013、2014。每个将仅包含具有相关年份的行。换句话说，我想过滤上面的表格，以便每年创建一个新的工作表。

我知道如何使用数据透视表工具（分析 - 选项 - 显示报告过滤器页面）创建多个工作表。我对 Pivot 解决方案不感兴趣，但要保留我原来的表结构。

我了解了高级过滤方法，但如果我想创建 100 个新工作表，这将无济于事。

有没有自动化的方法？最好不用 VBA。

Answer 1

以下是针对此问题的非 VBA 解决方案：

首先 - 确保没有完全相同的重复行（即所有列都相同）。如果您的表格中有重复的行/您不确定 - 没关系，只需在表格中添加一个新列，然后在该列中插入一个唯一值。我能想到的最简单的事情是在整个列中添加一个序列号（1、2、3……等等）。

现在，根据表格的范围创建一个数据透视表。 现在将所有表格列（不包括您要过滤的列）拖到“行”区域 - 包括数字列（在我们的例子中 - “销售”列）和“唯一值列”（如果已创建） . 之后，只需将要过滤的列拖到数据透视表中的“过滤器”区域

现在，在“数据透视表工具”-“设计”中，执行以下操作： 1. 小计 - 不显示小计 2.总计 - 行和列关闭 3.报表布局-以表格形式显示

现在，在“数据透视表工具 - 单击“分析” - 选项（在工具栏的左侧） - 显示报告过滤器页面 - 单击确定。享受！:)

请让我知道它是否适合您。

Answer 2

好的，这回答了问题（VBA 解决方案 - 测试它并且效果很好）：

https://www.extendoffice.com/documents/excel/1174-excel-split-data-into-multiple-worksheets-based-on-column.html

非常感谢斯莱。

Answer 3

子 Akshay99()

Dim my_rng As Range
Set my_rng = Nothing

Dim i As Integer
Dim j As Integer

If Len(Dir(ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name, ".", "-"), vbDirectory)) = 0 Then
    MkDir (ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name, ".", "-"))
End If

Dim curPath As String
curPath = ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name, ".", "-") & "\"

' MsgBox ActiveWorkbook.Name '----此程序由 Akshay Patil 撰稿，如果发现可编辑，将对人员采取严格措施 j = 0 将 MasterList 调暗为范围 '----需要的变量----------------------------- ------------------------- 将 Exl_data、Exl_Master、Exl_setting、filterExlName 作为字符串调暗 Dim E_filterfor, E_filterwith, E_filterExlName As String

Exl_setting = "Settings"
Exl_data = Sheets(Exl_setting).Range("E8").Value
Exl_Master = Sheets(Exl_setting).Range("E9").Value

E_filterfor = Sheets(Exl_setting).Range("E10").Value
E_filterwith = Sheets(Exl_setting).Range("E11").Value
E_filterExlName = Sheets(Exl_setting).Range("E12").Value


If Sheets(Exl_data).AutoFilterMode = True Then
    Sheets(Exl_data).AutoFilterMode = False
End If
 If Sheets(Exl_setting).AutoFilterMode = True Then
    Sheets(Exl_setting).AutoFilterMode = False
End If
'--------------Logic for getting first element to last from Data sheet for defining whole list-----------------
 Dim FirstCell As Range, LastCell As Range

 Set LastCell = Sheets(Exl_data).Cells(Sheets(Exl_data).Cells.Find(What:="*", SearchOrder:=xlRows, _
 SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
 Sheets(Exl_data).Cells.Find(What:="*", SearchOrder:=xlByColumns, _
 SearchDirection:=xlPrevious, LookIn:=xlValues).Column)

 Set FirstCell = Sheets(Exl_data).Cells(Sheets(Exl_data).Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _
 SearchDirection:=xlNext, LookIn:=xlValues).Row, _
 Sheets(Exl_data).Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _
 SearchDirection:=xlNext, LookIn:=xlValues).Column)
Set my_rng = Range(FirstCell, LastCell)
'-----------------------------------------
On Error Resume Next
Sheets(Exl_data).Columns.AutoFit

'=============================================== ====================================== Sheets(Exl_data).Range(E_filterwith & ":" & E_filterwith).NumberFormat = "@" Sheets(Exl_Master).Range(E_filterfor & ":" & E_filterfor).NumberFormat = "@" '================================================== ===================================== '=======首先我们将最后一个单元格名称作为主列表================================= ==================================================== ================= 设置 MasterList = Sheets(Exl_Master).Range(E_filterwith + "2:" + E_filterwith & Sheets(Exl_Master).Cells(Sheets(Exl_Master).Rows.Count, E_filterwith).End(xlUp).Row)

'=============================================== ==================================================== ==========

'=======For循环===================================== ==================================================== = 我 = 2 对于 MasterList.Value 中的每个单元格 ' --用于按主列表过滤数据---- my_rng.AutoFilter Field:=Sheets(Exl_data).Range(E_filterfor & ":" & E_filterfor).Column, Criteria1:="=" & cell filterExlName = Sheets(Exl_Master).Range(E_filterExlName & i).Value my_rng.复制 工作簿。添加 ActiveSheet.Paste ActiveSheet.Cells.EntireColumn.AutoFit ActiveWorkbook.SaveAs 文件名:=curPath & filterExlName & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 活动窗口.关闭 我 = 我 + 1 下一个单元格 MsgBox "成功生成 Excel 工作表数量" & i - 2 '================================================== ================================================

' ---------------------------------- -------------------------- If Sheets(Exl_data).AutoFilterMode = True Then Sheets(Exl_data).AutoFilterMode = False 万一 结束子