ไปยังเนื้อหาหลัก

วิธีแบ่งข้อมูลออกเป็นหลายแผ่นตามคอลัมน์ใน Excel

สมมติว่าคุณมีแผ่นงานที่มีข้อมูลจำนวนมากและตอนนี้คุณต้องแบ่งข้อมูลออกเป็นหลายแผ่นตาม Name คอลัมน์ (ดูภาพหน้าจอต่อไปนี้) และชื่อจะถูกป้อนแบบสุ่ม บางทีคุณอาจเรียงลำดับก่อนจากนั้นคัดลอกและวางทีละแผ่นในแผ่นงานใหม่อื่น ๆ แต่ต้องใช้ความอดทนในการคัดลอกและวางซ้ำ ๆ วันนี้ฉันจะพูดคุยเกี่ยวกับเทคนิคด่วนในการแก้ปัญหานี้

doc แยกข้อมูลตามคอลัมน์ 1

แยกข้อมูลออกเป็นหลายแผ่นตามคอลัมน์ด้วยรหัส VBA

แยกข้อมูลออกเป็นหลายแผ่นตามคอลัมน์ด้วย Kutools for Excel


แยกข้อมูลออกเป็นหลายแผ่นตามคอลัมน์ด้วยรหัส VBA

หากคุณต้องการแยกข้อมูลตามค่าคอลัมน์อย่างรวดเร็วและอัตโนมัติโค้ด VBA ต่อไปนี้เป็นตัวเลือกที่ดี กรุณาทำตามนี้:

1. กด ALT + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

2. คลิก สิ่งที่ใส่เข้าไป > โมดูลและวางรหัสต่อไปนี้ในหน้าต่างโมดูล

Sub Splitdatabycol()
'updateby Extendoffice
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
Dim xWS 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
Set xWS = Sheets.Add(after:=Worksheets(Worksheets.Count))
xWS.Name = myarr(i) & ""
Else
xWS.Move after:=Worksheets(Worksheets.Count)
End If
xWSTRg.Range(title).Copy
xWS.Paste Destination:=xWS.Range("A1")
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWS.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 สำหรับ Excelมัน แยกข้อมูล ยูทิลิตี้ไม่เพียง แต่ช่วยให้คุณแบ่งข้อมูลออกเป็นหลายแผ่นตามคอลัมน์ได้ แต่ยังสามารถแบ่งข้อมูลตามจำนวนแถวได้อีกด้วย

หมายเหตุที่จะใช้สิ่งนี้ แยกข้อมูลประการแรกคุณควรดาวน์โหลดไฟล์ Kutools สำหรับ Excelแล้วใช้คุณสมบัตินี้อย่างรวดเร็วและง่ายดาย

หลังจากการติดตั้ง Kutools สำหรับ Excelโปรดทำตามนี้:

1. เลือกช่วงของข้อมูลที่คุณต้องการแยก

2. คลิก Kutools พลัส > แผ่นงาน > แยกข้อมูลดูภาพหน้าจอ:

doc แยกข้อมูลตามคอลัมน์ 3

3. ใน แยกข้อมูลออกเป็นหลายแผ่นงาน คุณต้อง:

1). เลือก คอลัมน์เฉพาะ ตัวเลือกใน แยกตาม และเลือกค่าคอลัมน์ที่คุณต้องการแบ่งข้อมูลตามในรายการดรอปดาวน์ (หากข้อมูลของคุณมีส่วนหัวและคุณต้องการแทรกลงในแผ่นงานใหม่แต่ละแผ่นโปรดตรวจสอบ ข้อมูลของฉันมีส่วนหัว ตัวเลือก.)

2). จากนั้นคุณสามารถระบุชื่อแผ่นงานแยกภายใต้ ชื่อแผ่นงานใหม่ ระบุกฎชื่อเวิร์กชีตจากไฟล์ กฎระเบียบ รายการแบบเลื่อนลงคุณสามารถเพิ่มไฟล์ อุปสรรค or วิภัตติ สำหรับชื่อแผ่นงานด้วย

3). คลิก OK ปุ่ม. ดูภาพหน้าจอ:

doc แยกข้อมูลตามคอลัมน์ 4

4. ตอนนี้ข้อมูลถูกแบ่งออกเป็นหลายแผ่นในสมุดงานใหม่

doc แยกข้อมูลตามคอลัมน์ 5

คลิกเพื่อดาวน์โหลด Kutools สำหรับ Excel และทดลองใช้ฟรีทันที!


แยกข้อมูลออกเป็นหลายแผ่นตามคอลัมน์ด้วย Kutools for Excel

Kutools สำหรับ Excel มีเครื่องมือ Excel ที่มีประโยชน์มากกว่า 300 รายการ ทดลองใช้ฟรีโดยไม่มีข้อ จำกัด ใน 30 วัน ดาวน์โหลดทดลองใช้ฟรีทันที!


บทความที่เกี่ยวข้อง:

จะแบ่งข้อมูลออกเป็นหลายแผ่นตามจำนวนแถวได้อย่างไร?

สุดยอดเครื่องมือเพิ่มผลผลิตในสำนักงาน

🤖 Kutools AI ผู้ช่วย: ปฏิวัติการวิเคราะห์ข้อมูลโดยยึดตาม: การดำเนินการที่ชาญฉลาด   |  สร้างรหัส  |  สร้างสูตรที่กำหนดเอง  |  วิเคราะห์ข้อมูลและสร้างแผนภูมิ  |  เรียกใช้ฟังก์ชัน Kutools...
คุณสมบัติยอดนิยม: ค้นหา เน้น หรือระบุรายการที่ซ้ำกัน   |  ลบแถวว่าง   |  รวมคอลัมน์หรือเซลล์โดยไม่สูญเสียข้อมูล   |   รอบโดยไม่มีสูตร ...
การค้นหาขั้นสูง: VLookup หลายเกณฑ์    VLookup หลายค่า  |   VLookup ข้ามหลายแผ่น   |   การค้นหาที่ไม่ชัดเจน ....
รายการแบบเลื่อนลงขั้นสูง: สร้างรายการแบบหล่นลงอย่างรวดเร็ว   |  รายการแบบหล่นลงขึ้นอยู่กับ   |  เลือกหลายรายการแบบหล่นลง ....
ผู้จัดการคอลัมน์: เพิ่มจำนวนคอลัมน์เฉพาะ  |  ย้ายคอลัมน์  |  สลับสถานะการมองเห็นของคอลัมน์ที่ซ่อนอยู่  |  เปรียบเทียบช่วงและคอลัมน์ ...
คุณสมบัติเด่น: กริดโฟกัส   |  มุมมองการออกแบบ   |   บาร์สูตรใหญ่    สมุดงานและตัวจัดการชีต   |  ห้องสมุดทรัพยากร (ข้อความอัตโนมัติ)   |  เลือกวันที่   |  รวมแผ่นงาน   |  เข้ารหัส/ถอดรหัสเซลล์    ส่งอีเมลตามรายการ   |  ซุปเปอร์ฟิลเตอร์   |   ตัวกรองพิเศษ (กรองตัวหนา/ตัวเอียง/ขีดทับ...) ...
ชุดเครื่องมือ 15 อันดับแรก12 ข้อความ เครื่องมือ (เพิ่มข้อความ, ลบอักขระ, ... )   |   50 + แผนภูมิ ประเภท (แผนภูมิ Gantt, ... )   |   40+ ใช้งานได้จริง สูตร (คำนวณอายุตามวันเกิด, ... )   |   19 การแทรก เครื่องมือ (ใส่ QR Code, แทรกรูปภาพจากเส้นทาง, ... )   |   12 การแปลง เครื่องมือ (ตัวเลขเป็นคำ, การแปลงสกุลเงิน, ... )   |   7 ผสานและแยก เครื่องมือ (แถวรวมขั้นสูง, แยกเซลล์, ... )   |   ... และอื่น ๆ

เพิ่มพูนทักษะ Excel ของคุณด้วย Kutools สำหรับ Excel และสัมผัสประสิทธิภาพอย่างที่ไม่เคยมีมาก่อน Kutools สำหรับ Excel เสนอคุณสมบัติขั้นสูงมากกว่า 300 รายการเพื่อเพิ่มประสิทธิภาพและประหยัดเวลา  คลิกที่นี่เพื่อรับคุณสมบัติที่คุณต้องการมากที่สุด...

รายละเอียด


แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มประสิทธิภาพการทำงานของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
Comments (312)
Rated 5 out of 5 · 2 ratings
This comment was minimized by the moderator on the site
Sub SplitDataByColWorkbook()
Dim lr As Long
Dim ws As Worksheet
Dim vcol 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
Dim xWS As Workbook
Dim wb As Workbook


Set wb = ThisWorkbook
Set ws = wb.Sheets(1) ' Assuming you want to work with the first sheet in the workbook

On Error Resume Next
Set xTRg = Application.InputBox("Please select the header rows:", "Select Header Rows", Type:=8)
If xTRg Is Nothing Then Exit Sub

On Error Resume Next
Set xVRg = Application.InputBox("Please select the column you want to split data based on:", "Select Split Column", Type:=8)
If xVRg Is Nothing Then Exit Sub

vcol = xVRg.Column
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
Set xWS = Workbooks.Add
Else
Set xWS = Workbooks.Add
End If

Set xWSTRg = xWS.Sheets(1)
xTRg.Copy
xWSTRg.Range("A1").PasteSpecial Paste:=xlPasteValues
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) & ""
Set xWS = Workbooks.Add
Set xWSTRg = xWS.Sheets(1)
xTRg.Copy
xWSTRg.Range("A1").PasteSpecial Paste:=xlPasteValues
ws.Range("A" & (titlerow + xTRg.Rows.Count) & ":A" & lr).EntireRow.Copy xWSTRg.Range("A" & (titlerow + xTRg.Rows.Count))
xWSTRg.Columns.AutoFit
xWS.SaveAs myarr(i) & ".xlsx" ' Change the file name as needed
xWS.Close SaveChanges:=False
Next

ws.AutoFilterMode = False
wb.Activate
Application.DisplayAlerts = True
End Sub
This comment was minimized by the moderator on the site
First of all, thank you for the macro.

I would like to ask if there is any way to maintain the column widths. My 'original' tab was completely formatted. However, after running the macro, it loses the column formatting and appears quite messy.

English is not my first language (sorry).

Thank you again!
Rated 5 out of 5
This comment was minimized by the moderator on the site
The original header is not copied in the split sheet.
This comment was minimized by the moderator on the site
This works wonderfully, thank you very much!!! Huge time-saver.
Rated 5 out of 5
This comment was minimized by the moderator on the site
Hello,

I am having a hard time getting this code to work. When I run it, it just creates a duplicate sheet and does not split columns into multiple sheets.

I do have values that exceed 31 characters as well as special characters such as "-" and "()" in my column, how can I account for that without a lot of manual changes?
This comment was minimized by the moderator on the site
This worked great!!! One question... my formulas didn't transfer to each sheet correctly. What do I need to do differently to transfer the formulas?
Thank you!!!!!
This comment was minimized by the moderator on the site
Nice code, but it just copied everything to the new tables, named correctly though. So, the data filtering did not work at all, just copy paste.
This comment was minimized by the moderator on the site
When I run this using a small amount of data like the example it works. I'm trying to use this on a database with 400k + rows of data. When I run the macro, a second tab is created with just the header row and no data.
This comment was minimized by the moderator on the site
Hello, Ryan,

As you mentioned, the code works well for small data ranges, if there are lots of data, the code will not work properly.
In such situations, I recommend using the "Split Data" feature offered by Kutools for Excel. This powerful feature can greatly assist you in managing large amounts of data. To take advantage of this feature, you can download and install Kutools for Excel, which is available for a 30-day free trial.

Please have a try, thank you!
This comment was minimized by the moderator on the site
I've come across many solutions in VBA message boards for parsing data into worksheets or columns based upon filtering a particular column, but they all require a bit of tinkering and customization. What makes this so brilliant is that it is dynamic, user-friendly even for beginners (which gives it shareable utility), and copy/paste ready.

You rock.
This comment was minimized by the moderator on the site
Hi, Dane,
Thanks for your comment, glad this can help you! Have a good day!
This comment was minimized by the moderator on the site
When I try to split data from a different sheet, it copies and pastes the entire sheet into one sheet instead of multiple sheets. Could this be because the naming convention of the sheet I'm trying to split is similar to another sheet?
This comment was minimized by the moderator on the site
Hello, Giancarlo,

If the data in the column is same with a sheet name in the workbook, the sheet with the same name will be kept, other data will be split into separate sheet.
Thanks for your comment.
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations