ขอคำแนะนำเกี่ยวกับการลบแถวที่มีข้อมูลซ้ำกันหลายๆข้อมูล โดยใช้ VBA

[Kanok]

รบกวนขอคำแนะนำเกี่ยวกับการลบแถวที่มีข้อมูลซ้ำกัน ของหายๆกลุ่มข้อมูล

รายละเอียด :
-> ต้องการลบแถวที่มีข้อมูลซ้ำกัน (ข้อมูลในคอลัมภ์ C) ของแต่ละกลุ่ม(ข้อมูลอ้างอิงในคอลัมภ์ B)
-> ตัวอย่างเช่น : ข้อมูลอ้างอิงคือ X , ในที่นี้ กลุ่มของ X มี "1" ที่เป็นข้อมูลที่ซ้ำ
ซึ่งต้องการลบแถวที่มีข้อมูลซ้ำออกให้เหลือเพียงแถวเดียวค่ะ
ดังนั้น ข้อมูล X จะมี 2 แถว และค่่าในคอลัมภ์ C คือ 1 กับ 2 ค่ะ

Column B Column C

X ................1
X ............... 1
X ................1
X.................1
X.................2
Z................4
Z................4
Z................4
Z................4
Z................6

******************************
ลบค่าที่ซ้ำกันแล้วได้ดังนี้ :
ColumnB Column C
X.................1
X.................2
Z.................4
Z.................6

ในเบื้องต้นได้ลองทำการเขียน Code ดังนี้

Code: Select all

Sub Macro1()

Dim p As Long
Dim lastrowp As Long

lastrowp = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For p = 3 To lastrowp
If Cells(p, 2).Value & Cells(p, 3).Value = Cells(1 + p, 2).Value & Cells(1 + p, 3).Value Then
Rows(p).Delete

End If

Next p

End Sub

โดยแนวคิดคือ ให้มีการเปรียบเที่ยบระหว่าง 2 แถว ถ้าหากเจอค่าที่เท่ากัน ให้ลบแถวที่เจอแถวแรกออก
แต่ปัญหาคือไม่สามารถลบออกได้หมดค่ะ ยังคงมีค่าที่ซ้ำกันอยู่ค่ะ
*หมายเหตุ : มีไฟลแนบมาด้วยค่ะ

[iKeyman]

ปกติผมจะลบแถวโดยไม่ใช้ VBA
ไม่รุ้ว่าจะใช้เหมือนกันไหม ลองดูครับ

[snasui]

สามารถใช้การบันทึก Macro ในการทำ Remove Duplicate ตามที่คุณ iKeyman ตอบมาได้ หรือจะปรับ VBA เป็นตามด้านล่างครับ

Code: Select all

Dim rall As Range
Dim l As Long, i As Long
With Sheets("Sheet1")
    Set rall = .Range("b3", .Range("b" & .Rows.Count).End(xlUp))
    l = rall.Count
    For i = l To 1 Step -1
       If Application.CountIfs(rall, rall(i), rall.Offset(0, 1), rall(i).Offset(0, 1)) > 1 Then
            rall(i).EntireRow.Delete
       End If
    Next i
End With

[Kanok]

ขอบคุณมากค่ะ สำหรับคำแนะนำ