Cookies帮助我们提供我们的服务。 通过使用我们的服务,您同意我们使用Cookie。
提示:其他语言是Google翻译的。 你可以访问 English 版本。
登录
x
or
x
x
注册账户
x

or

如何根据Excel中的列将数据拆分为多个工作表?

假设你有一个包含大量数据的工作表,现在,你需要根据数据拆分成多个工作表 名称 列(请参见以下屏幕快照),并且名称是随机输入的。 也许你可以先对它们进行排序,然后将它们逐个复制并粘贴到其他新的工作表中。 但是这需要你耐心的重复复制和粘贴。 今天,我会谈谈一些快速的技巧来解决这个任务。

doc按列1分割数据

使用VBA代码将数据分割成多个基于列的工作表

使用Kutools for Excel将数据分割成多个基于列的工作表


根据工作表中的特定列或行数将数据拆分为多个工作表:

如果您想根据特定列数据或行数将大工作表分成多个工作表, Kutools for Excel's 拆分数据 功能可以帮助您快速轻松地解决此任务。

doc按列6分割数据

Kutools for Excel:比200方便的Excel加载项,可以在60天免费试用。 下载并免费试用现在!


使用VBA代码将数据分割成多个基于列的工作表


如果你想快速自动地根据列值拆分数据,下面的VBA代码是一个不错的选择。 请这样做:

1。 按住 ALT + F11 键打开 Microsoft Visual Basic for Applications 窗口。

2。 点击 插页 > 模块,并将以下代码粘贴到模块窗口中。

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 1        
Set ws = Sheets("Master sheet")        
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:C1"            
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate
End Sub

注意:在上面的代码中:

  • vcol = 1 , 号码 1 是您想要基于分割数据的列号。
  • 设置ws =表格(“主表单”), 母表 是您想要应用此代码的工作表名称。
  • title =“A1:C1” , A1:C1 是标题的范围。

所有这些都是变量,你可以根据需要改变它们。

3。 然后按 F5 键来运行代码,活动工作表中的所有数据都按列值分成多个工作表。 分割工作表用分割单元名称命名。 看截图:

doc按列2分割数据

注意:拆分工作表放置在主工作表所在工作簿的末尾。


使用Kutools for Excel将数据分割成多个基于列的工作表

作为一名Excel初学者,这个长的VBA代码对我们来说有些困难,而且我们大多数人甚至不知道如何根据需要修改代码。

在这里,我会介绍一个多功能的工具 - Kutools for Excel,它的 拆分数据 实用程序不仅可以帮助您根据列将数据拆分为多个工作表,还可以按行数拆分数据。

Kutools for Excel : 与超过300方便的Excel加载项,在60天免费试用没有限制.

如果你已经安装 Kutools for Excel请按照以下步骤进行:

1。 选择要分割的数据范围。

2。 点击 Kutools Plus > 工作表 > 拆分数据,看截图:

doc按列3分割数据

3。 在 将数据拆分为多个工作表 对话框中,您需要:

1)。 选择 专栏 在选项 根据分割 部分,然后从下拉列表中选择要分割数据的列值。 (如果您的数据包含标题,并且要将其插入到每个新的拆分工作表中,请检查 我的数据有标题 选项。)

2)。 然后,您可以指定拆分工作表名称 新的工作表名称 部分,从中指定工作表名称规则 规则 下拉列表中,可以添加 字首 or 后缀 表格名称也是如此。

3)。 点击 OK 按钮。 看截图:

doc按列4分割数据

4。 现在,数据在新的工作簿中被分成多个工作表。

doc按列5分割数据

点击下载Kutools for Excel和免费试用版吧!


使用Kutools for Excel将数据分割成多个基于列的工作表

Kutools for Excel 包含了比300更方便的Excel工具。 免费试用60天无限制。 立即下载免费试用!


相关文章:

如何按行数将数据拆分为多个工作表?



推荐的生产力工具

Office Tab

金星1 带上方便的选项卡到Excel和其他Office软件,就像Chrome浏览器,Firefox和新的Internet Explorer。

Kutools for Excel

金星1 惊人! 提高您在5分钟的生产力。 不需要任何特殊技能,每天保存两个小时!

金星1 300 Excel的新功能,让Excel变得简单而强大:

  • 合并单元格/行/列而不丢失数据。
  • 合并和合并多个工作表和工作簿。
  • 比较范围,复制多个范围,将文本转换为日期,单位和货币转换。
  • 按颜色计算,分页小计,高级分类和超级筛选,
  • 更多选择/插入/删除/文本/格式/链接/评论/工作簿/工作表工具...

Excel的Kutools屏幕截图

Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Jason · 1 months ago
    This formula is great, works perfectly for me.
    I want to split out data based on a location, which is in column 1. Which this does.
    However, is it possible to also split out based on column 2, for example. Built and Not Built. So a secondary condition also?
  • To post as a guest, your comment is unpublished.
    jose · 1 months ago
    can someone help please im using this but i keep getting to many columns. i have to keep deleting rows every time i use this.

    This is what im using


    Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 1
    Set ws = Sheets("sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:AN1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
    ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub
  • To post as a guest, your comment is unpublished.
    avinash · 1 months ago
    Thanks for VBA, it works great. In addition to that question, I have column which is dependent. So when i select some value my column values get changed hence I need vba solution to replace earlier split worksheet to replace with new value of columns. Can anyone help me out.?

    Thanks in advance
  • To post as a guest, your comment is unpublished.
    JP Tontegode · 1 months ago
    Is there a way to have the macro create a separate spreadsheet for each new tab instead of just adding a tab into the current worksheet? Thanks!
  • To post as a guest, your comment is unpublished.
    Sebastian · 1 months ago
    Effectively, this code does work great. I wrote an additional code so that I could get subtotal on certain columns but it has not worked great. So I tried running the subtotals from the master list, but afterwards when I use this macro it create a whole new tab for the Grand total row. So I am getting two two tabs per split. the first one is fine because it splits with the grand totals, but then creates a second one with just the grand total row. Any help as to how to modify this.
    This is the code that I am currently using:
    Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 3
    Set ws = Sheets("Master sheet")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:R1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
    On Error Resume Next
    If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
    ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
    End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
    ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
    If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
    Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
    Else
    Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
    End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
    End Sub