1、Excel 根据一个条件将一个表分成几个表Sub hjs()Dim irow, irow1, i, j As IntegerDim H As New CollectionDim sht As WorksheetDim ADim IColSheets(1).Name = “总表“Set A = ActiveCellApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseFor Each sht In SheetsIf sht.Name “总表“ Then sht.Delete 删除所有分表NextSheets(“总表“
2、).Copy Before:=Sheets(1) 加入新表来操作，以防破坏原数据中的公式或格式ICol = Application.InputBox(“请输入你所要分的列：（如按 B 列分请输入 2）“, “提示：“, “2“, Type:=1)If ICol = “ Then Exit SubOn Error Resume NextWith Sheets(“总表 (2)“)irow = .a1.CurrentRegion.Rows.CountFor i = 2 To irowCells(i, ICol) = “ & Cells(i, ICol) 在原工作表生成文本符号NextFor i =
3、2 To irowH.Add .Cells(i, ICol), CStr(.Cells(i, ICol)Next 建立一个不重复的筛选条件For i = 1 To H.Count.Cells.AutoFilter field:=ICol, Criteria1:=H(i)Sheets.Add(after:=Sheets(Sheets.Count).Name = H(i).a1.CurrentRegion.Copy Sheets(CStr(H(i).a1 自动筛选，并复制到新建的表中irow1 = a1.CurrentRegion.Rows.CountFor j = 2 To irow1Cells(j, ICol) = Right(Cells(j, ICol), Len(Cells(j, ICol) 消除新工作表文本符号Next j.Cells.AutoFilterDebug.Print H(i)Next i.Delete 操作表此时已多余，故删除End WithA.Parent.Activate 激活汇总表的原来激活的单元格A.ActivateApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub
