anhtuan1066
Thành viên gạo cội
- Tham gia
- 10/3/07
- Bài viết
- 5,802
- Được thích
- 6,913
Thấy có nhiều bạn hỏi về chủ đề so sánh 2 danh sách. Trên diễn đàn cũng đã có nhiều bài trả lời bằng nhiều thuật toán khác nhau. Hôm nay tôi viết 1 hàm tổng quát về Compare2List với 3 tùy chọn:
- Tìm các phần tử có cả trong danh sách 1 và danh sách 2
- Tìm các phần tử có trong danh sách 1 mà không có trong danh sách 2
- Tìm các phần tử có trong danh sách 2 mà không có trong danh sách 1
Code như sau:
Áp dụng Ví dụ bạn có 2 danh sách: DS1 nằm ở A2:A60000 và DS2 nằm ở B2:B60000
1> Để tìm các phần tử có trong 2 danh sách
2> Để tìm các phần tử có trong danh sách 1 mà không có trong danh sách 2
3> Để tìm các phần tử có trong danh sách 2 mà không có trong danh sách 1
Code này dùng phương pháp xử lý mảng nên tốc độ rất cao. Thử nghiệm với 2 danh sách dài 65000 dòng, ra kết quả trong vòng 4 giây
Mời xem file và kiểm tra
- Tìm các phần tử có cả trong danh sách 1 và danh sách 2
- Tìm các phần tử có trong danh sách 1 mà không có trong danh sách 2
- Tìm các phần tử có trong danh sách 2 mà không có trong danh sách 1
Code như sau:
PHP:
Function Compare2List(ByVal sArray1, ByVal sArray2, ByVal CompareMod As Long)
Dim Dic1, Dic2, Item, Item1, Item2, TmpKeys1, TmpKeys2, Arr() as String
Dim Tmp1 As String, Tmp2 As String, j As Long, ub As Long
On Error Resume Next
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
For Each Item1 In sArray1
If CStr(Item1) <> "" Then
Tmp1 = CStr(Item1)
If Not Dic1.Exists(Tmp1) Then Dic1.Add Tmp1, ""
End If
Next
TmpKeys1 = Dic1.Keys
For Each Item2 In sArray2
If CStr(Item2) <> "" Then
Tmp2 = CStr(Item2)
If Not Dic2.Exists(Tmp2) Then Dic2.Add Tmp2, ""
End If
Next
TmpKeys2 = Dic2.Keys
ub = IIf(Dic1.Count > Dic2.Count, Dic1.Count, Dic2.Count)
ReDim Arr(1 To ub, 1 To 1)
Select Case CompareMod
Case 1
For Each Item In TmpKeys1
If Dic2.Exists(CStr(Item)) Then
j = j + 1
Arr(j, 1) = CStr(Item)
End If
Next
Case 2
For Each Item In TmpKeys1
If Not Dic2.Exists(CStr(Item)) Then
j = j + 1
Arr(j, 1) = CStr(Item)
End If
Next
Case 3
For Each Item In TmpKeys2
If Not Dic1.Exists(CStr(Item)) Then
j = j + 1
Arr(j, 1) = CStr(Item)
End If
Next
End Select
Compare2List = Arr
End Function1> Để tìm các phần tử có trong 2 danh sách
PHP:
Sub Main1()
Dim sArray1, sArray2, Arr, TG As Double
On Error Resume Next
TG = Timer
sArray1 = Range("A2:A65536").Value
sArray2 = Range("B2:B65536").Value
Arr = Compare2List(sArray1, sArray2, 1)
Range("D2").Resize(UBound(Arr, 1)).Value = Arr
MsgBox Timer - TG
End Sub
PHP:
Sub Main2()
Dim sArray1, sArray2, Arr, TG As Double
On Error Resume Next
TG = Timer
sArray1 = Range("A2:A65536").Value
sArray2 = Range("B2:B65536").Value
Arr = Compare2List(sArray1, sArray2, 2)
Range("E2").Resize(UBound(Arr, 1)).Value = Arr
MsgBox Timer - TG
End Sub
PHP:
Sub Main3()
On Error Resume Next
Dim sArray1, sArray2, Arr, TG As Double
TG = Timer
sArray1 = Range("A2:A65536").Value
sArray2 = Range("B2:B65536").Value
Arr = Compare2List(sArray1, sArray2, 3)
Range("F2").Resize(UBound(Arr, 1)).Value = Arr
MsgBox Timer - TG
End SubMời xem file và kiểm tra
).
.
