มาโครตัดคำที่ซ้ำ ใช้งานไปแล้วตัดเหลือ แค่ 3 รายการ

[titus]

รบกวนช่วยดูมาโครด้วยครับ
ต้องการตัดรายการที่ซ้ำในแถว ทั้ง หมด 105 รายการ
คงเหลือที่ไม่ซ้ำ 86 รายการ
แต่พอมาเขียนมาโคร มันตัดเหลือแค่ 3 รายการ
แก้ไขจุดไหนดีครับ

Code: Select all

Sub removenameDup()
    Sheets("ยอดบัญชี").Select
    Columns("A:A").Select
    Selection.Copy
    Columns("E:E").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("E1").Select
    Range(Selection, Selection.End(xlDown)).Select
    myrange1 = ActiveCell.Address
    ActiveSheet.Range(myrange1).RemoveDuplicates Columns:=1, Header:=xlNo
    ActiveWorkbook.Worksheets("ยอดบัญชี").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("ยอดบัญชี").Sort.SortFields.Add Key:=Range( _
        myrange1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ยอดบัญชี").Sort
        .SetRange Range(myrange1)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

[DhitiBank]

รบกวนทำไฟล์ตัวอย่างแนบมาด้วยได้ไหมครับ ตามกฎข้อ 4 ด้านบนเอามาแค่ตัวอย่างไม่ต้องส่งข้อมูลสำคัญนะครับ การจะดูว่าซ้ำหรือไม่ซ้ำคงต้องดูข้อมูลด้วยครับ บางทีเห็นว่าข้อความหรือตัวเลขเหมือนกัน แต่มันอาจไม่เหมือนกันจริงๆ ก็ได้ครับ

[titus]

ได้เเล้ว ครับ เปลี่ยนเครื่อง มา ทำได้เฉยเลย ครับ

[titus]

ไฟล์แนบครับ

[DhitiBank]

อาจสามารถตัดบางบรรทัดทิ้งได้ครับ และแนะนำคำสั่ง sort อีกแบบหนึ่งครับ

Code: Select all

Public Sub Test()
    Dim r As Range
    With Sheets(1)
        .Activate
        .Range("e:e").Clear
        Set r = .Range("a1:a" & .Range("a" & .Rows.Count).End(xlUp).Row)
        r.Offset(, 4).Value = r.Value
        r.Offset(, 4).RemoveDuplicates Columns:=1, Header:=xlNo
        r.Offset(, 4).Sort key1:=.Range("e1") _
            , order1:=xlAscending, Header:=xlNo
    End With
End Sub