Thử code.Xin chào các bạn, xin nhờ các bạn giúp mình so sánh ID hai sheet 1 và 2, nếu kết quả không trùng ở cả 2 sheet thì xuất sang sheet 3 như hình với.
Rất mong nhận được sự giúp đỡ từ mọi người.
Xin cảm ơn!
P/s: Mình cũng đã thử mấy bài gần giống giống trên diễn đàn nhưng không áp dụng được.
Sub asda()
Dim i As Long, lr As Long, dic As Object, dk As String, arr, data, kq, a As Long
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A2:B" & lr).Value
For i = 1 To UBound(arr)
dk = arr(i, 1) & "A"
If Not dic.exists(dk) Then
dic.Add dk, ""
End If
Next i
End With
With Sheets("sheet2")
lr = .Range("A" & Rows.Count).End(xlUp).Row
data = .Range("A2:B" & lr).Value
ReDim kq(1 To UBound(arr) + UBound(data), 1 To 2)
For i = 1 To UBound(data)
dk = data(i, 1) & "A"
If Not dic.exists(dk) Then
dic.Add dk, ""
a = a + 1
kq(a, 1) = data(i, 1)
kq(a, 2) = data(i, 2)
End If
dk = data(i, 1) & "B"
If Not dic.exists(dk) Then
dic.Add dk, ""
End If
Next i
For i = 1 To UBound(arr)
dk = arr(i, 1) & "B"
If Not dic.exists(dk) Then
dic.Add dk, ""
a = a + 1
kq(a, 1) = arr(i, 1)
kq(a, 2) = arr(i, 2)
End If
Next i
End With
With Sheets("sheet3")
.Range("A2:B1000").ClearContents
If a Then .Range("A2:B2").Resize(a).Value = kq
End With
Set dic = Nothing
End SubChạy đúng y, cảm ơn rất nhiều.
Cái này sheet 1 cho vào dic.xong qua sheet 2 cái nào có trong dic rồi thì remove. Chưa có cho vào dic có ổn không anh nhỉ?
anh ơi, nếu muốn mở rộng vùng so sánh và lấy dữ liệu thì sửa ở chỗ nào ạ
em sửa được vùng lấy dữ liệu rồi ạ, nếu mình muốn lấy dự liệu trùng nhau thì sửa như thế nào ạ, e cảm ơn
Da. Cám ơn anh đã phản hồi. Ngồi vọc vạch theo suy nghĩ của mình.
Option Explicit
Sub Abc()
Dim dic As Object, Arr(), Res(1 To 100000, 1 To 2)
Dim sArr(), i&, k&, Key, iR
Set dic = CreateObject("scripting.dictionary")
With Sheet1
iR = .Range("A" & Rows.Count).End(3).Row
Arr = .Range("A2:B" & iR).Value
For i = 1 To UBound(Arr)
If dic.exists(Arr(i, 1)) = False Then
dic.Item(Arr(i, 1)) = i
End If
Next
End With
With Sheet2
iR = .Range("A" & Rows.Count).End(3).Row
sArr = .Range("A2:B" & iR).Value
For i = 1 To UBound(sArr)
If dic.exists(sArr(i, 1)) = True Then
dic.Remove (sArr(i, 1))
Else
k = k + 1
Res(k, 1) = sArr(i, 1)
Res(k, 2) = sArr(i, 2)
End If
Next
For Each Key In dic.keys
k = k + 1
Res(k, 1) = Key
Res(k, 2) = Arr(dic.Item(Key), 2)
Next
End With
If k Then
Sheet3.Range("C2:D1000").ClearContents
Sheet3.Range("C2").Resize(k, 2).Value = Res
End If
End SubCám ơn thầy. Đoạn không dùng dic. Em cũng chưa nghĩ ra được không dùng dic. Mà không sort thì sẽ làm thế nào. Nhưng để em thử xem theo cách em nghĩ thế nàoNếu dữ liệu sheet2 bị trùng thì tèo
Thử không dùng dic xem sao
Sort dữ liệu trước tốc độ sẽ nhanh hơn nhiều
Nếu xóa rồi mà nó lại xuất hiện thêm lần nữa thì sao nhỉ.
Sort lại dùng công cụ excel nếu data của họ không muốn thay đổi thì sao anh.Mà không dùng Dictionary thì dùng mảng à anh.
Lưu dữ liệu gốc vào mảng, sort và xử lý xong trả lại dữ liệu gốc, hoặc sort bằng VBA
ID là số nguyên, tạo mảng dùng ID làm thứ tự dòng là cách sort và lấy dữ liệu trùng hoặc thiếu đơn giản và nhanh nhất
Cần gì code.
Tại sao cách 2 lại phải sort trước anh nhỉ.Để cho hàm match nó chạy nhanh hơn à.
Hì cái này thì thuật toán nó vẫn giống Dictionary.Chẳng qua là nó duyệt duy nhất bằng mảng thôi.Nhưng em thấy bài của anh Hiếu cần kết hợp với sort để nó nhanh hơn.Có thể duyệt chạy song song được 2 mảng 1 vòng lặp là có kết quả ấy.
Match với tham thứ 3 là 1 dùng phép dò nhị phân, rất nhanh. Nhưng vì nó dò gần đúng cho nên khi ra vị trí rồi thì phải lấy từ vị trí ấy ra để xét lại có chính xác. Tuy phải làm vậy nhưng vẫn hiệu quả hơn cách dò với tham là 0. Trừ phi dữ kiệu rất ít.
