วิธีสร้างรายการค่าที่ไม่ซ้ำกันจากแผ่นงานหลายแผ่นใน Excel
มีวิธีที่รวดเร็วในการสร้างรายการค่าที่ไม่ซ้ำกันจากแผ่นงานทั้งหมดภายในสมุดงานหรือไม่? ตัวอย่างเช่นฉันมีเวิร์กชีตสี่แผ่นซึ่งรายชื่อบางชื่อมีรายการที่ซ้ำกันในคอลัมน์ A และตอนนี้ฉันต้องการแยกชื่อที่ไม่ซ้ำกันทั้งหมดจากแผ่นงานเหล่านี้ไปยังรายการใหม่ฉันจะทำงานนี้ให้เสร็จใน Excel ได้อย่างไร
สร้างรายการค่าที่ไม่ซ้ำกันจากแผ่นงานหลายแผ่นด้วยรหัส VBA
สร้างรายการค่าที่ไม่ซ้ำกันจากแผ่นงานหลายแผ่นด้วยรหัส VBA
หากต้องการแสดงรายการค่าที่ไม่ซ้ำกันทั้งหมดจากแผ่นงานทั้งหมดรหัส VBA ต่อไปนี้อาจช่วยคุณได้โปรดทำดังนี้:
1. กด ALT + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง
2. คลิก สิ่งที่ใส่เข้าไป > โมดูลและวางมาโครต่อไปนี้ในไฟล์ โมดูล หน้าต่าง.
รหัส VBA: สร้างรายการค่าที่ไม่ซ้ำกันจากแผ่นงานหลายแผ่น:
Sub SheelsUniqueValues()
Dim xObjNewWS As Worksheet
Dim xObjWS As Worksheet
Dim xStrAddress As String
Dim xIntRox As Long
Dim xIntN As Long
Dim xFNum As Integer
Dim xMaxC, xColumn As Integer
Dim xR As Range
xStrName = "Unique value"
Application.ScreenUpdating = False
xMaxC = 0
Application.DisplayAlerts = False
For Each xObjWS In Sheets
If xObjWS.Name = xStrName Then
xObjWS.Delete
Exit For
End If
Next
Application.DisplayAlerts = True
For xFNum = 1 To Sheets.Count
xColumn = Sheets(xFNum).Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If xMaxC < xColumn Then
xMaxC = xColumn
End If
Next xFNum
Application.DisplayAlerts = True
Set xObjNewWS = Sheets.Add(after:=Sheets(Sheets.Count))
xObjNewWS.Name = xStrName
For xColumn = 1 To xMaxC
xIntN = 1
For xFNum = 1 To Sheets.Count - 1
Set xR = Sheets(xFNum).Columns(xColumn)
If TypeName(Sheets(xFNum).Columns(xColumn).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)) <> "Nothing" Then
xIntRox = xR.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets(xFNum).Range(Cells(1, xColumn).Address & ":" & Cells(xIntRox, xColumn).Address).Copy
Cells(xIntN, xColumn).PasteSpecial xlValues
xIntN = xIntRox + xIntN + 1
End If
Next xFNum
If xIntRox - 1 > 0 Then
xIntRox = xIntN - 1
xStrAddress = Cells(1, xColumn).Address & ":" & Cells(xIntRox, xColumn).Address
Range(xStrAddress).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range(xStrAddress).Copy
Cells(1, xColumn + 1).PasteSpecial xlValues
Range(xStrAddress).AdvancedFilter Action:=xlFilterInPlace, Unique:=False
Columns(xColumn).Delete
Range(xStrAddress).Sort key1:=Cells(1, xColumn), Header:=xlNo
End If
Next xColumn
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
3. หลังจากวางโค้ดด้านบนแล้วกด F5 เพื่อเรียกใช้รหัสนี้และแผ่นงานใหม่ชื่อ ค่าที่ไม่ซ้ำกัน ถูกสร้างขึ้นและชื่อเฉพาะในคอลัมน์ A จากแผ่นงานทั้งหมดจะแสดงเป็นภาพหน้าจอต่อไปนี้:
สุดยอดเครื่องมือเพิ่มผลผลิตในสำนักงาน
เพิ่มพูนทักษะ Excel ของคุณด้วย Kutools สำหรับ Excel และสัมผัสประสิทธิภาพอย่างที่ไม่เคยมีมาก่อน Kutools สำหรับ Excel เสนอคุณสมบัติขั้นสูงมากกว่า 300 รายการเพื่อเพิ่มประสิทธิภาพและประหยัดเวลา คลิกที่นี่เพื่อรับคุณสมบัติที่คุณต้องการมากที่สุด...
แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก
- เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
- เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
- เพิ่มประสิทธิภาพการทำงานของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!