提示:其他語言是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 Splitdatabycol()
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
Dim xTRg As Range
Dim xVRg As Range
Dim xWSTRg As Worksheet
On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
If TypeName(xTRg) = "Nothing" Then Exit Sub
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", Type:=8)
If TypeName(xVRg) = "Nothing" Then Exit Sub
vcol = xVRg.Column
Set ws = xTRg.Worksheet
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = xTRg.AddressLocal
titlerow = xTRg.Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
Application.DisplayAlerts = False
If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
Else
Sheets("xTRgWs_Sheet").Delete
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
End If
Set xWSTRg = Sheets("xTRgWs_Sheet")
xTRg.Copy
xWSTRg.Paste Destination:=xWSTRg.Range("A1")
ws.Activate
For i = (titlerow + xTRg.Rows.Count) 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
xWSTRg.Range(title).Copy
Sheets(myarr(i) & "").Paste Destination:=Sheets(myarr(i) & "").Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A" & (titlerow + xTRg.Rows.Count))
Sheets(myarr(i) & "").Columns.AutoFit
Next
xWSTRg.Delete
ws.AutoFilterMode = False
ws.Activate
Application.DisplayAlerts = True
End Sub

3。 然後按 F5 鍵運行代碼,彈出提示框提醒您選擇標題行,見截圖:

doc按列7分割數據

4。 然後點擊 OK 按鈕,在第二個提示框中,請選擇要拆分的列數據,請參見屏幕截圖:

doc按列8分割數據

5。 然後,點擊 OK,並且活動工作表中的所有數據都按列值拆分為多個工作表。 拆分工作表以拆分單元名稱命名。 看截圖:

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.
    pradeep sharma · 6 months ago
    I have used this VBA code, its split the data but split whole data in new sheet instead of unique value.
  • To post as a guest, your comment is unpublished.
    Pradeep Sharma · 6 months ago
    The VBA code split the data perfectly but its split the whole data instead of unique value.
  • To post as a guest, your comment is unpublished.
    Jorge Portillo · 6 months ago
    The codes works perfectly, only trouble is that it does not separate columns when the text is too long, I have text with 40 characters and I get an empty "sheet2", every other text gets sorted.


    Any ideas on how to fix it? I've already tried changin variable and placed them as Long, however I am not sure I fully understand the program. all this for the VBA option.
  • To post as a guest, your comment is unpublished.
    Manish · 7 months ago
    I need a macro for following condition
    suppose i have customer excel file in which first 7 rows is for header so, from 8th row records are start
    i need to split rows of 500 record each in one file and save them with name customer1,customer2,customer3,........
    suppose i have customer file of 2540 records so it split in
    customer1 which have header rows with record starts from 8th row to 507th row
    customer2 which have header rows with record starts from 508th row to 1007th row
    customer3 which have header rows with record starts from 1008th row to 1507th row
    customer4 which have header rows with record starts from 1508th row to 2007th row
    customer5 which have header rows with record starts from 2008th row to 2507th row
    customer6 which have header rows with record starts from 2508th row to 2540th row
    • To post as a guest, your comment is unpublished.
      parabola hiperbola · 2 months ago
      hi. I have similar situation, I want to keep first 8 rows in every sheet created. did you find any solution to this?
      • To post as a guest, your comment is unpublished.
        skyyang · 2 months ago
        Hi, guys,
        If your worksheet data contains multiple header rows, the below VBA code can solve your prolem, please try it.

        Sub Parse_data_0213()
        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
        Dim xTRg As Range
        Dim xVRg As Range
        Dim xWSTRg As Worksheet
        On Error Resume Next
        Set xTRg = Application.InputBox("Please select the header rows:", "Kutools for Excel", "", Type:=8)
        If TypeName(xTRg) = "Nothing" Then Exit Sub
        Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Kutools for Excel", "", Type:=8)
        If TypeName(xVRg) = "Nothing" Then Exit Sub
        vcol = xVRg.Column
        Set ws = xTRg.Worksheet
        lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
        title = xTRg.AddressLocal
        titlerow = xTRg.Cells(1).Row
        icol = ws.Columns.Count
        ws.Cells(1, icol) = "Unique"
        Application.DisplayAlerts = False
        If Not Evaluate("=ISREF('xTRgWs_Sheet!A1')") Then
        Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
        Else
        Sheets("xTRgWs_Sheet").Delete
        Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "xTRgWs_Sheet"
        End If
        Set xWSTRg = Sheets("xTRgWs_Sheet")
        xTRg.Copy
        xWSTRg.Paste Destination:=xWSTRg.Range("A1")
        ws.Activate
        For i = (titlerow + xTRg.Rows.Count) 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
        xWSTRg.Range(title).Copy
        Sheets(myarr(i) & "").Paste Destination:=Sheets(myarr(i) & "").Range("A1")
        ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A" & (titlerow + xTRg.Rows.Count))
        Sheets(myarr(i) & "").Columns.AutoFit
        Next
        xWSTRg.Delete
        ws.AutoFilterMode = False
        ws.Activate
        Application.DisplayAlerts = True
        End Sub

        Hope it can help you, thank you!
  • To post as a guest, your comment is unpublished.
    Dilusha · 7 months ago
    How can I get the Total of Column C for each sheets.?