So sánh dữ liệu bằng vba

[hoabattu3387]

Hi cả nhà!
Mọi người tìm lỗi giúp mình đoạn code sau sai chỗ nào nhé. Mục đích của mình là so sánh 2 cột D, E và 2 cột A,B, nếu có sự khác nhau bất kỳ nào của D so với A, hoặc E so với B thì sẽ lấy dữ liệu tương xứng sang sheets 2. Lẽ ra nếu đúng thì theo ví dụ sau 2 dòng này 427360 427361 VÀ 427367 427368 nhưng mình ko hiểu sai gì mà nó lại lấy tất cả sang sheets 2
Sub Oval1_Click()
Dim a, b, i, j, t, k As Integer
Dim arr(), arr1(), arr2()
Set check = ThisWorkbook.Sheets(1)
a = check.Range("a65536").End(xlUp).Row
b = check.Range("d65536").End(xlUp).Row
ReDim arr(1 To b, 1 To 2)
ReDim arr1(1 To a, 1 To 2)
ReDim arr2(1 To b, 1 To 2)
For t = 1 To a
arr1(t, 1) = check.Range("a" & t)
arr1(t, 2) = check.Range("b" & t)
Next
For k = 1 To b
arr(k, 1) = check.Range("d" & k)
arr(k, 2) = check.Range("e" & k)
Next
For i = 1 To b
For j = 1 To a
If arr(i, 1) = arr1(j, 1) And arr(i, 2) = arr1(j, 2) Then
Exit For
Else
arr2(i, 1) = arr(i, 1)
arr2(i, 2) = arr(i, 2)
End If
Next
Next
ThisWorkbook.Sheets(2).Range("A1:B" & b) = arr2


End Sub

 

[ndu96081631]

Hi cả nhà!
Mọi người tìm lỗi giúp mình đoạn code sau sai chỗ nào nhé. Mục đích của mình là so sánh 2 cột D, E và 2 cột A,B, nếu có sự khác nhau bất kỳ nào của D so với A, hoặc E so với B thì sẽ lấy dữ liệu tương xứng sang sheets 2. Lẽ ra nếu đúng thì theo ví dụ sau 2 dòng này 427360 427361 VÀ 427367 427368 nhưng mình ko hiểu sai gì mà nó lại lấy tất cả sang sheets 2

Gì mà For.. Next quá trời đất vậy?
Tôi chỉ cần vầy:

Sub Oval1_Click()
  Dim i As Long, k As Long
  Dim arr1, arr2
  Dim check As Worksheet
  Set check = ThisWorkbook.Sheets(1)
  arr1 = check.Range("A2:B1001").Value
  arr2 = check.Range("D2:E1001").Value
  ReDim arr(1 To 1000, 1 To 2)
  For i = 1 To 1000
    If (arr1(i, 1) <> arr2(i, 1)) Or (arr1(i, 2) <> arr2(i, 2)) Then
      k = k + 1
      arr(k, 1) = arr2(i, 1)
      arr(k, 2) = arr2(i, 2)
    End If
  Next
  If k Then Sheets(2).Range("A1:B" & k) = arr
End Sub

 

[hoabattu3387]

Sư phụ kiểm tra lại giúp e với, e thử chạy code theo cách của sư phụ vẫn ko được, lẽ ra ở sheets 2 chỉ có 2 dòng sai lệch 427360 427361 VÀ 427367 427368 nhưng ở đây nó lại hiện ra tất cả

 

[hpkhuong]

Sư phụ kiểm tra lại giúp e với, e thử chạy code theo cách của sư phụ vẫn ko được, lẽ ra ở sheets 2 chỉ có 2 dòng sai lệch 427360 427361 VÀ 427367 427368 nhưng ở đây nó lại hiện ra tất cả

Xóa hết kết quả của bạn ở sheet2 đi. rồi chạy lại code của anh NDU, làm gì có vụ lấy hết qua.
Bạn thấy còn là do bạn chưa Clear cái kết quả cũ của bạn.......

 

[lhthai]

Sư phụ kiểm tra lại giúp e với, e thử chạy code theo cách của sư phụ vẫn ko được, lẽ ra ở sheets 2 chỉ có 2 dòng sai lệch 427360 427361 VÀ 427367 427368 nhưng ở đây nó lại hiện ra tất cả

Thử code này coi đúng ý bạn không

Sub Oval1_Click()
Dim Dic As Object, sArr(), dArr(), i As Long, k As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
        sArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 2).Value
        For i = 1 To UBound(sArr, 1)
            Tem = sArr(i, 1) & sArr(i, 2)
            If Not Dic.exists(Tem) Then
                Dic.Add Tem, Empty
            End If
        Next i


    sArr = .Range(.[D2], .[D2].End(xlDown)).Resize(, 2).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 2)
    For i = 1 To UBound(sArr, 1)
        Tem = sArr(i, 1) & sArr(i, 2)
        If Not Dic.exists(Tem) Then
            k = k + 1
            Dic.Add Tem, Empty
            dArr(k, 1) = sArr(i, 1)
            dArr(k, 2) = sArr(i, 2)
        End If
    Next i
    End With
    
    With Sheet2
    .[A2:B5000].ClearContents
    .[A2].Resize(k, 2) = dArr
    End With
End Sub

 

[hoabattu3387]

em xem lại code thì sư phụ hình như hiểu sai ý e rồi? e cần so sánh D và E với A và B nhưng ko phải so sánh ngang từng hàng, mà từng cặp giá trị D, E tìm hết trong các cặp A, B ạ. Em sửa lại như sau mà ko được
Sub Oval1_Click()
Dim i As Long, k As Long
Dim arr1, arr2
Dim check As Worksheet
Set check = ThisWorkbook.Sheets(1)
arr1 = check.Range("A2:B1001").Value
arr2 = check.Range("D2:E1001").Value
ReDim arr(1 To 1000, 1 To 2)
For i = 1 To 1000
For j = 1 To 1000
If (arr2(i, 1) <> arr1(j, 1)) Or (arr2(i, 2) <> arr1(j, 2)) Then
k = k + 1
arr(k, 1) = arr2(i, 1)
arr(k, 2) = arr2(i, 2)
End If
Next
Next
If k Then Sheets(2).Range("A1:B" & k) = arr
End Sub

 

[ndu96081631]

em xem lại code thì sư phụ hình như hiểu sai ý e rồi? e cần so sánh D và E với A và B nhưng ko phải so sánh ngang từng hàng, mà từng cặp giá trị D, E tìm hết trong các cặp A, B ạ. Em sửa lại như sau mà ko được

Vậy thì càng dễ, dùng Advanced Filter chứ không for.. next gì cả:

Sub Oval1_Click()
  With Sheets("check")
    .Range("IV2") = "=SUMPRODUCT(($A$2:$A$1000=D2)*($B$2:$B$1000=E2))=0"
    .Range("D1:E1").Value = .Range("A1:B1").Value
    .Range("D1:E1000").AdvancedFilter xlFilterCopy, .Range("IV1:IV2"), Sheets("Sheet2").Range("A1")
    .Range("D1:E1").ClearComments
    .Range("IV2").ClearContents
  End With
End Sub

Nếu là tôi thì thậm chí cũng không cần code, cứ Advanced Filter bằng tay được rồi

 

[Minh Khôi_2008]

nhờ các bác làm giúp em VAB so sánh dữ liệu cột A - B so sánh với cột C - D ở sheet "Dữ liệu" cho ra kết quả ở sheet "Kết quả". Em cám ơn các bác nhiều

 

[Hoàng Tuấn 868]

nhờ các bác làm giúp em VAB

Vụ này là mình chịu rồi.