สอบถาม Code VB จัดข้อมูลที่ซ้ำกัน ให้เอามาเพียงรายการเดียว

[tigerwit]

จากไฟล์ที่แนบมา
ที่ sheet1 เก็บข้อมูลวัสดุที่ซื้อเข้ามาแต่ละครั้ง ซึ่งจะมีซ้ำกันบางรายการ
ต้องการ ดึงรายการข้อมูลจาก Sheet1 ไปไว้ที่ Sheet2 โดยรายการใดซ้ำ ให้เอามาเพียงรายการเดียว
จากโค๊ด

Code: Select all

Sub CutStockToNewSheet()
On Error Resume Next
With Sheets("sheet2")
        .Range("B2:B50000").Value = Sheets("sheet1").Range("G2:G50000").Value
        .Range("C2:C50000").Value = Sheets("sheet1").Range("H2:H50000").Value
        .Range("D2:D50000").Value = Sheets("sheet1").Range("I2:I50000").Value
    With .Range("B2", .Range("b" & .Rows.Count).End(xlUp))
        .RemoveDuplicates Columns:=1, Header:=xlNo
    End With
End With
    Range("B2").Select
End Sub

สามารถดึงรายการวัสดุมาได้ แต่ในส่วนของ หน่วยนับกับราคาต่อหน่วยนั้น
ยังไม่สามารถ ลบออกได้ จะต้องเขียนโค๊ดเพิ่มเติมอย่างไร เพื่อจะลบส่วนนี้ออก
เอาให้เหลือเท่ากับแถวสุดสุดที่มีข้อมูลของรายการวัสดุ

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub CutStockToNewSheet()
    On Error Resume Next
    With Sheets("sheet2")
            .Range("B2:D50000").Value = Sheets("sheet1").Range("G2:I50000").Value
'            .Range("C2:C50000").Value = Sheets("sheet1").Range("H2:H50000").Value
'            .Range("D2:D50000").Value = Sheets("sheet1").Range("I2:I50000").Value
        With .Range("B2", .Range("b" & .Rows.Count).End(xlUp)).Resize(, 3)
            .RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
        End With
    End With
'        Range("B2").Select
End Sub