บันทึกข้อมูลที่มี ID เดียวกันมากกว่า 1 รายการในฐานข้อมูล

[piches]

สวัสดีครับอาจารย์และเพื่อนสมาชิกทุกท่าน ผมขอคำแนะนำแก้ไข Code ด้วยครับ
หากมี่ ID เดียวกันมากกว่า 1 รายการในฐานข้อมูล ให้เอาบรรทัดสุดท้าย เพื่อไม่ให้บันทึกทับรายการที่ทำรายการเสร็จเรียบร้อยแล้ว
ต้องแก้ไขยังไงครับ

Code: Select all

Sub TEST()
Dim rall As Range, r As Range
With Worksheets("form")
    If .Range("A2").Value = "" Then End
    Set rall = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set wb = Workbooks.Open("C:\Users\IT\Desktop\New folder (3)\dbtest.xlsx", False, False)
For Each r In rall
    i = Worksheets("Sheet1").Range("a:a").Find(r, LookIn:=xlValues).Row
    r.Resize(1, 4).Copy
    Worksheets("Sheet1").Range("a" & i).Resize.Offset(0, 0).PasteSpecial xlPasteFormats
    Worksheets("Sheet1").Range("a" & i).Resize.Offset(0, 0).PasteSpecial xlPasteValues
       Application.CutCopyMode = False
Next r
wb.Close True
End Sub

[snasui]

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

Code: Select all

Sub TEST()
    Dim rall As Range, r As Range
    Dim dataAll As Range
    Dim l As Long, allRows As Long
    
    With Worksheets("form")
        If .Range("A2").Value = "" Then End
        Set rall = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With
    
    Set wb = Workbooks.Open("C:\Users\IT\Desktop\New folder (3)\dbtest.xlsx", False, False)
    With wb.Sheets("Sheet1")
        Set dataAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
        allRows = dataAll.Rows.Count
    End With
    
    For Each r In rall
        For l = allRows To 1 Step -1
            'i = Worksheets("Sheet1").Range("a:a").Find(r, LookIn:=xlValues).Row
            If dataAll(l).Value = r.Value Then
                r.Resize(1, 4).Copy
                dataAll(l).Resize(1, 4).PasteSpecial xlPasteFormats
                dataAll(l).Resize(1, 4).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                Exit For
            End If
        Next l
    Next r
    wb.Close True
End Sub

[piches]

ขอบคุณครับอาจารย์ ตัวอย่าง Code ใช้ได้ตามต้องการครับ