VBA 技巧：将汇总表格按部门拆分成多个表格

通过VBA可以使用以下代码将一个汇总表格按照各部门拆分成多个表格：\n\nvba\nSub SplitByDepartment()\n Dim wsSrc As Worksheet\n Dim wsDest As Worksheet\n Dim rngSrc As Range\n Dim rngDest As Range\n Dim cell As Range\n Dim dept As String\n \n ' 设置源表格\n Set wsSrc = ThisWorkbook.Worksheets("汇总表")\n ' 设置源数据范围\n Set rngSrc = wsSrc.Range("A1").CurrentRegion\n \n ' 创建目标表格\n Set wsDest = ThisWorkbook.Worksheets.Add\n \n ' 循环遍历源数据\n For Each cell In rngSrc.Columns(1).Offset(1).Resize(rngSrc.Rows.Count - 1)\n ' 获取部门名称\n dept = cell.Value\n \n ' 检查目标表格是否已经存在\n On Error Resume Next\n Set rngDest = wsDest.Range("A1").CurrentRegion\n On Error GoTo 0\n \n ' 如果目标表格已经存在，则追加数据\n If Not rngDest Is Nothing Then\n If rngDest.Columns(1).Find(dept, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then\n Set rngDest = rngDest.Offset(rngDest.Rows.Count).Resize(1)\n rngDest.Cells(1, 1).Value = dept\n Else\n Set rngDest = rngDest.Columns(1).Find(dept).Offset(1).End(xlDown).Offset(1).Resize(1)\n End If\n Else ' 如果目标表格不存在，则创建新表格并添加部门名称\n Set rngDest = wsDest.Range("A1").Resize(1)\n rngDest.Cells(1, 1).Value = dept\n End If\n \n ' 复制数据到目标表格\n rngSrc.Rows(cell.Row).Copy rngDest.Offset(1)\n Next cell\n \n ' 格式化目标表格\n wsDest.Activate\n wsDest.Cells.EntireColumn.AutoFit\nEnd Sub\n\n\n请将代码中的"汇总表"替换为实际的源表格名称，然后运行此宏即可。此宏将会在同一工作簿中创建一个新的工作表，并按照各部门拆分源表格中的数据到不同的工作表中。每个工作表以部门名称命名，并包含相应的数据。