建个宏 vba模块
Sub chaifen() Dim clm_d As Integer Dim mycell As Range Dim Nodupes As New Collection Dim rngOp As Range Set ShtOp = ActiveSheet clm_d = Application.InputBox(prompt:="请选择作为拆分条件的列" _ & Chr(13) & "注意:" & Chr(13) & "1、拆分区域需要有标题行!" & Chr(13) & "2、直接 _输入列号,不要用鼠标选取", Type:=1) If clm_d = False Then Exit Sub On Error Resume Next For Each mycell In ShtOp.Range(Cells(2, clm_d), (ShtOp.Cells(2, clm_d).End(xlDown))) Nodupes.Add mycell.Value, CStr(mycell.Value) Next mycell On Error GoTo 0 ''''''''''''''''''' Set rngOp = Cells.CurrentRegion For Each Item In Nodupes rngOp.AutoFilter clm_d, Criteria1:=Item rngOp.Copy Sheets.Add after:=ActiveSheet ActiveSheet.Name = Item ActiveSheet.Paste Next Item rngOp.AutoFilter ShtOp.Activate End Sub
|