วิธีย้ายแถวที่ซ้ำกันไปยังแผ่นงานอื่นใน Excel
หากคุณมีรายการช่วงข้อมูลที่มีค่าที่ซ้ำกันในคอลัมน์เฉพาะตอนนี้คุณต้องการย้ายทั้งแถวไปยังแผ่นงานอื่นโดยยึดตามเซลล์ที่ซ้ำกัน คุณจะจัดการกับงานนี้ใน Excel ได้อย่างไร?
ย้ายทั้งแถวไปยังแผ่นงานอื่นโดยยึดตามเซลล์ที่ซ้ำกันในคอลัมน์
ย้ายทั้งแถวไปยังแผ่นงานอื่นโดยยึดตามแถวที่ซ้ำกัน
ย้ายทั้งแถวไปยังแผ่นงานอื่นโดยยึดตามเซลล์ที่ซ้ำกันในคอลัมน์
หากมีค่าที่ซ้ำกันในคอลัมน์ให้ย้ายทั้งแถวไปยังแผ่นงานอื่นรหัส VBA ต่อไปนี้สามารถช่วยคุณได้:
1. กด ALT + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง
2. คลิก สิ่งที่ใส่เข้าไป > โมดูลและวางรหัสต่อไปนี้ในหน้าต่างโมดูล
รหัส VBA: ย้ายทั้งแถวไปยังแผ่นงานอื่นตามเซลล์ที่ซ้ำกันในคอลัมน์:
Sub CutDuplicates()
'Updateby Extendoffice
Dim xRgS As Range
Dim xRgD As Range
Dim I As Long, J As Long
On Error Resume Next
Set xRgS = Application.InputBox("Please select the column:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a desitination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
xRows = xRgS.Rows.Count
J = 0
For I = xRows To 1 Step -1
If Application.WorksheetFunction.CountIf(xRgS, xRgS(I)) > 1 Then
xRgS(I).EntireRow.Copy xRgD.Offset(J, 0)
xRgS(I).EntireRow.Delete
J = J + 1
End If
Next
End Sub
3. จากนั้นกด F5 คีย์เพื่อเรียกใช้รหัสนี้และในกล่องโต้ตอบที่โผล่ออกมาให้เลือกคอลัมน์ที่มีเซลล์ที่ซ้ำกันที่คุณต้องการย้ายตามดูภาพหน้าจอ:
4. จากนั้นคลิก OKในกล่องพร้อมต์อื่นโปรดเลือกเซลล์ในแผ่นงานอื่นที่คุณต้องการใส่แถวที่ย้ายดูภาพหน้าจอ:
5. จากนั้นคลิก OKแถวที่มีค่าซ้ำกันในคอลัมน์ A ถูกย้ายไปยังแผ่นงานใหม่ดูภาพหน้าจอ:
ย้ายทั้งแถวไปยังแผ่นงานอื่นโดยยึดตามแถวที่ซ้ำกัน
หากคุณต้องการย้ายแถวที่ซ้ำกันจากช่วงของเซลล์โค้ด VBA ต่อไปนี้สามารถช่วยคุณได้:
1. กด ALT + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง
2. คลิก สิ่งที่ใส่เข้าไป > โมดูลและวางรหัสต่อไปนี้ในหน้าต่างโมดูล
รหัส VBA: ย้ายทั้งแถวไปยังแผ่นงานอื่นตามแถวที่ซ้ำกัน:
Sub CutDuplicates()
'Updateby Extendoffice
Dim xRgD As Range, xRgS As Range
Dim I As Long, J As Long, K As Long, KK As Long
On Error Resume Next
Set xRgS = Application.InputBox("Please select the data range:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a desitination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
KK = 0
For I = xRgS.Rows.Count To 1 Step -1
For J = 1 To I - 1
For K = 1 To xRgS.Columns.Count
Debug.Print xRgS.Rows(I).Cells(, K).Value
Debug.Print xRgS.Rows(J).Cells(, K).Value
If xRgS.Rows(I).Cells(, K).Value <> xRgS.Rows(J).Cells(, K).Value Then Exit For
Next
If K = xRgS.Columns.Count + 1 Then
xRgS.Rows(I).EntireRow.Copy xRgD.Offset(KK, 0).EntireRow
xRgS.Rows(I).EntireRow.Delete
KK = KK + 1
End If
Next
Next
End Sub
3. จากนั้นกด F5 คีย์เพื่อเรียกใช้รหัสนี้ในกล่องโต้ตอบที่โผล่ขึ้นมาให้เลือกเลือกช่วงข้อมูลที่คุณต้องการย้ายแถวที่ซ้ำกันดูภาพหน้าจอ:
4. คลิก OK จากนั้นในกล่องพร้อมต์อื่นให้เลือกเซลล์ในแผ่นงานใหม่ที่คุณต้องการใส่แถววิงวอนที่ย้ายดูภาพหน้าจอ:
5. จากนั้นคลิก OK และตอนนี้แถวที่ซ้ำกันถูกย้ายไปยังแผ่นงานอื่นที่คุณระบุพร้อมกันดูภาพหน้าจอ:
สุดยอดเครื่องมือเพิ่มผลผลิตในสำนักงาน
เพิ่มพูนทักษะ Excel ของคุณด้วย Kutools สำหรับ Excel และสัมผัสประสิทธิภาพอย่างที่ไม่เคยมีมาก่อน Kutools สำหรับ Excel เสนอคุณสมบัติขั้นสูงมากกว่า 300 รายการเพื่อเพิ่มประสิทธิภาพและประหยัดเวลา คลิกที่นี่เพื่อรับคุณสมบัติที่คุณต้องการมากที่สุด...
แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก
- เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
- เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
- เพิ่มประสิทธิภาพการทำงานของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
