如何将一个Excel工作表的数据按一列的关键字拆分成多个工作表

哈雷

2019-05-28

来源：巨盒创意

日常工作中，我们可能要将一个excel工作表数据按照某一列的关键词进行分开为独立的工作表，一般我们是一个一个的复制粘贴另存为等操作，但是如果我们的数据量很大时，这样做是很麻烦的事情，下面给大家介绍一个十分简单的方法，几秒钟实现我们的目的！

1、用office excel软件打开要拆分的数据工作薄，在标签上右键>>点击“查看代码”

2、在打开的代码窗口复制以下代码粘贴 >> 回到要拆分的数据表，选择标题最后一行与条件数据所在列的单元格，比如共有1行标题，按第二列分配数据，就选择B2格，然后运行下面的宏。

Sub 拆分工作表()

Dim Dic As Object, Arr, N&, I&, T&, Ws As Worksheet, Rng As Range, R As Range, Del As Range

On Error Resume Next

Set Dic = CreateObject("scripting.dictionary")

Set Ws = ActiveSheet

Set R = ActiveCell

T = Cells.SpecialCells(xlCellTypeLastCell).Row

For Each Rng In Range(R.Offset(1), Cells(T, R.Column))

If Rng.Value <> "" Then Dic(Rng.Value) = ""

Next Rng

Arr = Dic.keys

Application.ScreenUpdating = False

For N = LBound(Arr) To UBound(Arr)

Ws.Copy after:=Worksheets(Worksheets.Count)

With ActiveSheet

.Name = Arr(N)

For Each Rng In .Range(.Range(R.Address).Offset(1), .Cells(T, R.Column))

If Rng.Value <> Arr(N) Then

If Del Is Nothing Then

Set Del = Rng

Else

Set Del = Union(Del, Rng)

End If

Next Rng

Del.EntireRow.Delete

Set Del = Nothing

End With

Next N

Application.ScreenUpdating = True

Set Dic = Nothing

End Sub

运行完成后，在工作薄中会出现已经按关键词拆分好的工作表，如下图所示：

关注巨盒创意微信公众号，免费学习更多精品教程，高效、便捷办公。

阅读676

写评论...