拆分数据到分表

Sub 拆分数据到分表()

Call 删除重复值

Dim bm As Range

'按照N列的数据创建工作表

    For Each bm In Range("N2:N" & Range("N65536").End(xlUp).Row)

        Sheets.Add after:=Sheets(Sheets.Count)

        Sheets(Sheets.Count).Name = bm.Value

    Next

Dim j As Integer

    For j = 2 To Sheets.Count

'    按照表名称筛选数据并复制到对应表中

        Sheets(1).Range("A:L").AutoFilter Field:=2, Criteria1:=Sheets(j).Name

        Sheets(1).Range("A:L").Copy Sheets(j).Range("A1")

'        删除每个分表的第N列

        Sheets(j).Range("N:N").Delete

'        取消第一个表的筛选状态

        Sheets(1).Range("A:L").AutoFilter

    Next

    MsgBox "所有工作已经完成"

End Sub

'代码编写鹤壁市 huanghe

Sub 删除重复值()

Sheets(1).Range("N:O").Clear

Sheets(1).Range("B:B").Copy Sheets(1).Range("N1")

'复制A列数据到N列

ActiveSheet.Range("N:N").RemoveDuplicates Columns:=1, Header:=xlYes

'删除N列重复值

Dim rng As Range

'声明rng为单元格变量

    For Each rng In Range("N2:N" & Range("N65536").End(xlUp).Row)

        rng.Offset(0, 1) = Application.WorksheetFunction.CountIf(Range("B:B"), rng)

        Sheets(1).Range("O1") = "数量"

    Next

' 用for each函数遍历N列有数据的单元格，用offset偏离函数在O列求重复次数

End Sub