Code VBA so sánh và loại bỏ các giá trị trùng lặp giữa 2 Sheet

 Mẫu hiển thị như sau

Sub RemoveAndRecordDuplicates()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim cell As Range
    Dim dict As Object
    Dim dictDuplicates As Object
    Dim i As Long
    Dim key As Variant

    ' Thiết lập các worksheet
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    Set ws4 = ThisWorkbook.Sheets("Sheet4")

    ' Xoá nội dung cũ trong Sheet3 và Sheet4
    ws3.Cells.Clear
    ws4.Cells.Clear

    ' Tạo đối tượng Dictionary để lưu trữ giá trị của Sheet1
    Set dict = CreateObject("Scripting.Dictionary")
    ' Tạo đối tượng Dictionary để lưu trữ giá trị trùng lặp
    Set dictDuplicates = CreateObject("Scripting.Dictionary")

    ' Đọc dữ liệu từ Sheet1 và lưu vào Dictionary
    With ws1
        For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            dict(.Cells(i, 1).Value) = True
        Next i
    End With

    ' Xử lý dữ liệu từ Sheet2 và phân loại trùng lặp
    With ws2
        For Each cell In .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
            If dict.exists(cell.Value) Then
                ' Nếu giá trị trùng lặp, lưu vào Dictionary trùng lặp
                If Not dictDuplicates.exists(cell.Value) Then
                    dictDuplicates.Add cell.Value, True
                End If
            Else
                ' Nếu giá trị không trùng lặp, sao chép vào Sheet3
                ws3.Cells(ws3.Cells(ws3.Rows.Count, 1).End(xlUp).Row + 1, 1).Value = cell.Value
            End If
        Next cell
    End With

    ' Ghi các giá trị trùng lặp vào Sheet4
    With ws4
        i = 1
        For Each key In dictDuplicates.keys
            .Cells(i, 1).Value = key
            i = i + 1
        Next key
    End With

    ' Thông báo hoàn tất
    MsgBox "Da hoan tat viec loai bo gia tri trung lạp va ghi ket qua vao sheet3 sheet4", vbInformation
End Sub


Cách hoạt động:

  1. Xóa nội dung cũ: Đoạn mã ws3.Cells.Clearws4.Cells.Clear đảm bảo rằng dữ liệu cũ trên Sheet3 và Sheet4 được xóa trước khi ghi kết quả mới.
  2. Tìm giá trị trùng lặp: Các giá trị trùng lặp giữa Sheet1 và Sheet2 được tìm thấy và ghi vào Sheet4.
  3. Lọc giá trị không trùng lặp: Các giá trị còn lại của Sheet2 mà không trùng lặp với bất kỳ giá trị nào trong Sheet1 sẽ được ghi vào Sheet3.

Bạn có thể copy và dán mã này vào Excel VBA Editor và chạy để thực hiện yêu cầu của mình.

Nhận xét

Bài đăng phổ biến