เคล็ดลับของ Excel: แบ่งข้อมูลออกเป็นแผ่นงาน / สมุดงานหลายแผ่นตามค่าคอลัมน์

เมื่อจัดการชุดข้อมูลขนาดใหญ่ใน Excel จะมีประโยชน์อย่างมากในการแบ่งข้อมูลออกเป็นหลายแผ่นงานตามค่าคอลัมน์ที่ระบุ วิธีการนี้ไม่เพียงปรับปรุงการจัดระเบียบข้อมูล แต่ยังเพิ่มความสามารถในการอ่านและอำนวยความสะดวกในการวิเคราะห์ข้อมูลได้ง่ายขึ้น

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

แบ่งข้อมูลออกเป็นหลายแผ่นงานตามค่าคอลัมน์

• โดยใช้โค้ด VBA
• โดยใช้คุณลักษณะที่มีประสิทธิภาพ-Kutools สำหรับ Excel

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

แบ่งข้อมูลออกเป็นหลายแผ่นงานตามค่าคอลัมน์

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

แบ่งข้อมูลออกเป็นหลายแผ่นงานตามค่าคอลัมน์ด้วยรหัส 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 เพื่อเรียกใช้โค้ด และกล่องพร้อมท์จะปรากฏขึ้นเพื่อเตือนให้คุณเลือกแถวส่วนหัว จากนั้นจึงคลิก OK. ดูภาพหน้าจอ:

4. ในกล่องข้อความที่สอง โปรดเลือกข้อมูลคอลัมน์ที่คุณต้องการแบ่งตาม จากนั้นคลิก OK. ดูภาพหน้าจอ:

5. ข้อมูลทั้งหมดในแผ่นงานที่ใช้งานอยู่จะถูกแบ่งออกเป็นแผ่นงานหลายแผ่นตามค่าของคอลัมน์ แผ่นงานผลลัพธ์จะถูกตั้งชื่อตามค่าในเซลล์แยกและวางไว้ที่ส่วนท้ายของสมุดงาน ดูภาพหน้าจอ:

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

Kutools สำหรับ Excel นำเสนอคุณสมบัติอันชาญฉลาด - แยกข้อมูล เข้าสู่สภาพแวดล้อม Excel ของคุณ การแบ่งข้อมูลออกเป็นหลายแผ่นงานไม่ใช่เรื่องท้าทายอีกต่อไป เครื่องมือที่ใช้งานง่ายของเราจะแบ่งชุดข้อมูลของคุณโดยอัตโนมัติตามค่าคอลัมน์หรือจำนวนแถวที่เลือก เพื่อให้มั่นใจว่าข้อมูลแต่ละชิ้นอยู่ในตำแหน่งที่คุณต้องการ บอกลางานที่น่าเบื่อในการจัดระเบียบสเปรดชีตด้วยตนเอง และหันมาใช้วิธีจัดการข้อมูลที่รวดเร็วยิ่งขึ้นและปราศจากข้อผิดพลาด

หลังจากการติดตั้ง Kutools สำหรับ Excelเลือกช่วงข้อมูล จากนั้นคลิก Kutools พลัส > แยกข้อมูล เพื่อเปิด แยกข้อมูลออกเป็นหลายแผ่นงาน กล่องโต้ตอบ

1. เลือก คอลัมน์เฉพาะ ตัวเลือกใน แยกตาม และเลือกค่าคอลัมน์ที่คุณต้องการแบ่งข้อมูลตามจากรายการแบบเลื่อนลง
2. หากข้อมูลของคุณมีส่วนหัวและคุณต้องการแทรกลงในแผ่นงานแยกใหม่แต่ละแผ่น โปรดตรวจสอบ ข้อมูลของฉันมีส่วนหัว ตัวเลือก. (คุณสามารถระบุจำนวนแถวส่วนหัวตามข้อมูลของคุณ ตัวอย่างเช่น หากข้อมูลของคุณมีสองส่วนหัว โปรดพิมพ์ 2)
3. จากนั้นคุณสามารถระบุชื่อแผ่นงานแยกภายใต้ ชื่อแผ่นงานใหม่ ส่วนระบุกฎชื่อแผ่นงานจากรายการแบบเลื่อนลงกฎคุณสามารถเพิ่มได้ อุปสรรค or วิภัตติ สำหรับชื่อแผ่นงานด้วย
4. คลิก OK ปุ่ม. ดูภาพหน้าจอ:
   

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

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

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

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

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

Sub SplitDataByColToWorkbooks()
    ' Updateby Extendoffice
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    Dim xTRg As Range
    Dim xVRg As Range
    Dim xWS As Workbook
    Dim savePath As String
    ' Set the directory to save new workbooks
    savePath = "C:\Users\AddinsVM001\Desktop\multiple files\" ' Modify this path as needed
    Application.DisplayAlerts = False
    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.Address(False, False)
    titlerow = xTRg.Row
    ws.Columns(vcol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Cells(1, ws.Columns.Count), Unique:=True
    myarr = Application.Transpose(ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).Value)
    ws.Cells(1, ws.Columns.Count).Resize(ws.Cells(ws.Rows.Count, ws.Columns.Count).End(xlUp).Row).ClearContents
    For i = 2 To UBound(myarr)
        Set xWS = Workbooks.Add
        ws.Range(title).AutoFilter Field:=vcol, Criteria1:=myarr(i)
        ws.Range("A" & titlerow & ":A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy
        xWS.Sheets(1).Cells(1, 1).PasteSpecial Paste:=xlPasteAll
        xWS.SaveAs Filename:=savePath & myarr(i) & ".xlsx"

        xWS.Close SaveChanges:=False
    Next i
    ws.AutoFilterMode = False
    Application.DisplayAlerts = True
    ws.Activate
End Sub

3. จากนั้นกด F5 เพื่อเรียกใช้โค้ด และกล่องพร้อมท์จะปรากฏขึ้นเพื่อเตือนให้คุณเลือกแถวส่วนหัว จากนั้นจึงคลิก OK. ดูภาพหน้าจอ:

4. ในกล่องข้อความที่สอง โปรดเลือกข้อมูลคอลัมน์ที่คุณต้องการแบ่งตาม จากนั้นคลิก OK. ดูภาพหน้าจอ:

5. หลังจากแยกข้อมูลทั้งหมดในแผ่นงานที่ใช้งานอยู่จะถูกแบ่งออกเป็นสมุดงานหลายเล่มตามค่าของคอลัมน์ สมุดงานแยกทั้งหมดจะถูกบันทึกลงในโฟลเดอร์ที่คุณระบุ ดูภาพหน้าจอ:

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

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

🤖	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% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!

อ่านเพิ่มเติม ... ดาวน์โหลดฟรี...