Excel根据多列分组拆分成多个文件

背景

        有一个需求要求把Excel根据两列或多列分组拆分成多个文件，网上搜的都是只能根据1列去生成，没有多列的情况。问AI也一直有错误。最后在AI的基础上进行了修改，完成。

示例

        假如我们有这样一个表格，想根据学校和班级来分组：

学校	班级	姓名
学校1	班级1	a
学校1	班级1	b
学校1	班级2	c
学校1	班级2	d
学校2	班级1	e
学校2	班级1	f
学校2	班级2	g
学校2	班级2	h

        最终分成4个表格，最终结果是分成4个文件：学校1班级1，学校1班级2，学校2班级1，学校2班级2。类似下面这种：

学校	班级	姓名
学校1	班级1	a
学校1	班级1	b

学校	班级	姓名
学校1	班级2	c
学校1	班级2	d

步骤

将数据排序

        因为程序中是自上而下进行处理，需要先将数据排序，不然结果有误。

        将“学校”和“班级”列分别按照“升序”排列。

勾选开发工具

        为了方便，先把开发工具调出来。在[文件-选项-自定义功能区]中，将右边的【开发工具】勾上。

新建VB程序

        【alt+F11】调出VB面板，如图插入【模块】，在窗口中粘贴如下代码。【ctrl+s】保存。

Sub SplitWorkbookBySchoolAndClass()
    Dim dataSheet As Worksheet
    Dim outputSheet As Worksheet
    Dim currentRow As Long
    Dim lastRow As Long
    Dim startRFow As Long
    Dim school As String
    Dim class1 As String
    Dim filePath As String
    Dim fileDirectory As String
    Dim previousSchool As String
    Dim previousClass As String
    
    ' 设置数据源工作表名称
    Set dataSheet = ThisWorkbook.Sheets("Sheet1") ' 更改为你的数据源工作表名称

    ' 获取数据源的最后一行
    lastRow = dataSheet.Cells(dataSheet.Rows.Count, "A").End(xlUp).Row

    ' 初始化学校和班级变量
    previousSchool = ""
    previousClass = ""
    ' 下一次开始的行数
    startRFow =  2
    ' 设置生成文档目录
    fileDirectory = "C:\Users\CGF\Desktop\新建文件夹\"
    ' 遍历数据源中的每一行
    For currentRow = 2 To lastRow
        ' 获取当前行的学校和班级
        school = dataSheet.Range("A" & currentRow).Value
        class1 = dataSheet.Range("B" & currentRow).Value
        
        ' 如果学校或班级发生变化，并且之前已经有学校和班级记录，则创建新的工作簿并保存
        If (school <> previousSchool Or class1 <> previousClass) And (previousSchool <> "" And previousClass <> "") Then
            ' 设置文件路径和名称
            filePath = fileDirectory & previousSchool & "-" & previousClass & ".xlsx" ' 更改为你的输出文件夹路径

            ' 创建新的工作簿
            Set outputSheet = Workbooks.Add(xlWBATWorksheet).Sheets("Sheet1")

            ' 复制当前班级的数据到新工作簿（包括标题行）
            dataSheet.Range("A1:C1").Copy outputSheet.Range("A1")
            dataSheet.Range("A" & startRFow & ":C" & currentRow - 1).Copy outputSheet.Range("A2")
            startRFow = currentRow
            ' 保存新工作簿并关闭
            Application.DisplayAlerts = False
            outputSheet.Parent.SaveAs Filename:=filePath
            outputSheet.Parent.Close SaveChanges:=False
            Application.DisplayAlerts = True
        End If

        ' 更新学校和班级变量
        previousSchool = school
        previousClass = class1
    Next currentRow

    ' 处理最后一组学校和班级数据
    If previousSchool <> "" And previousClass <> "" Then
        ' 设置文件路径和名称
        filePath = fileDirectory & previousSchool & "-" & previousClass & ".xlsx" ' 更改为你的输出文件夹路径

        ' 创建新的工作簿
        Set outputSheet = Workbooks.Add(xlWBATWorksheet).Sheets("Sheet1")

        ' 复制当前班级的数据到新工作簿（包括标题行）
        dataSheet.Range("A1:C1").Copy outputSheet.Range("A1")
        dataSheet.Range("A" & startRFow & ":C" & currentRow - 1).Copy outputSheet.Range("A2")

        ' 保存新工作簿并关闭
        Application.DisplayAlerts = False
        outputSheet.Parent.SaveAs Filename:=filePath
        outputSheet.Parent.Close SaveChanges:=False
        Application.DisplayAlerts = True
    End If

    MsgBox "拆分完成!"
End Sub

新建执行按钮

        上一步其实已经可以运行了。但是为了方便调用，我们再加一个执行按钮。

        按钮可以新建一个Sheet页，也可以在之前的Sheet上。点击[开发工具-插入-表单控件-按钮]，新建按钮。

        选择我们刚才的VB程序名

右键点击按钮，可以重命名。

执行

        单机按钮，就会开始执行了。执行完可以看到在文件夹下生成了4个文件：

        检查文件，没有问题：

修改

        如果有更多列的需求，可以更改判断条件；

        如果不止3列，可以修改复制条件，把C列改为真实需求列；

        大概就这个思路