[Help] VBA So sánh 02 danh sách và tìm ra Project bị thiếu

[robinhsoon]

Thân chào cả nhà GPEX!

Mong cả nhà giúp em một việc ạ.
Hiện tại em có 1 File data gồm 02 Sheet ("Danh sach" và "Data"). Em muốn so sánh giữa Cột A - Sheet "Danh sách" và Cột W - Sheet "Data", Những Project nào bên Sheet Data có mà Sheet Danh sách không có. Xuất ra giá trị ở cột C sheet "Danh Sách".. Ngược lại nếu không bị Missing thì Xuất thông báo "OK".

Mong cả nhà giúp đỡ ạ.. Em chân thành cảm ơn.

 

[hoanganhvo2612]

Thân chào cả nhà GPEX!

Mong cả nhà giúp em một việc ạ.
Hiện tại em có 1 File data gồm 02 Sheet ("Danh sach" và "Data"). Em muốn so sánh giữa Cột A - Sheet "Danh sách" và Cột W - Sheet "Data", Những Project nào bên Sheet Data có mà Sheet Danh sách không có. Xuất ra giá trị ở cột C sheet "Danh Sách".. Ngược lại nếu không bị Missing thì Xuất thông báo "OK".

Mong cả nhà giúp đỡ ạ.. Em chân thành cảm ơn.

sao bạn k dùng công thức? countif là được mà

 

[Hoàng Nhật Phương]

Thân chào cả nhà GPEX!

Mong cả nhà giúp em một việc ạ.
Hiện tại em có 1 File data gồm 02 Sheet ("Danh sach" và "Data"). Em muốn so sánh giữa Cột A - Sheet "Danh sách" và Cột W - Sheet "Data", Những Project nào bên Sheet Data có mà Sheet Danh sách không có. Xuất ra giá trị ở cột C sheet "Danh Sách".. Ngược lại nếu không bị Missing thì Xuất thông báo "OK".

Mong cả nhà giúp đỡ ạ.. Em chân thành cảm ơn.

Bạn thử chạy code dưới xem có đúng không ạ:

Option Explicit

Public Sub SoSanh()
    Dim Dic As Object, Ws As Worksheet, sArr(), dArr(), rng As Range
    Dim I As Long, K As Long, R As Long, EndR As Long, Txt As String
        
    With Sheets("Data")
        EndR = .Range("W100000").End(xlUp).Row
        If EndR = 1 Then Exit Sub
        Set Dic = CreateObject("Scripting.Dictionary")
        sArr = .Range("W2:W" & EndR).Value
        R = UBound(sArr)
        For I = 2 To R
            Txt = sArr(I, 1)
            If Not Dic.Exists(Txt) Then Dic.Item(Txt) = ""
        Next I
    End With
    
    With Sheets("Danh sach")
        EndR = .Range("A10000").End(xlUp).Row
        If EndR = 1 Then GoTo End_
            sArr = .Range("A2", .Range("A" & EndR + 1)).Value
            R = UBound(sArr)
            ReDim dArr(1 To R, 1 To 1)
            For I = 1 To R
                If sArr(I, 1) <> Empty Then
                    Txt = sArr(I, 1)
                    If Dic.Exists(Txt) Then
                        dArr(I, 1) = ""
                    Else
                        dArr(I, 1) = Txt
                    End If
                End If
            Next I
        Set rng = .Range("D2")
        With rng
            .Resize(R) = dArr
            .Resize(R).Sort rng, xlAscending
        End With
    End With
End_:
    Set Dic = Nothing
End Sub

 

[Hoàng Nhật Phương]

....

 

[robinhsoon]

Bạn thử chạy code dưới xem có đúng không ạ:

Option Explicit

Public Sub SoSanh()
    Dim Dic As Object, Ws As Worksheet, sArr(), dArr(), rng As Range
    Dim I As Long, K As Long, R As Long, EndR As Long, Txt As String
       
    With Sheets("Data")
        EndR = .Range("W100000").End(xlUp).Row
        If EndR = 1 Then Exit Sub
        Set Dic = CreateObject("Scripting.Dictionary")
        sArr = .Range("W2:W" & EndR).Value
        R = UBound(sArr)
        For I = 2 To R
            Txt = sArr(I, 1)
            If Not Dic.Exists(Txt) Then Dic.Item(Txt) = ""
        Next I
    End With
   
    With Sheets("Danh sach")
        EndR = .Range("A10000").End(xlUp).Row
        If EndR = 1 Then GoTo End_
            sArr = .Range("A2", .Range("A" & EndR + 1)).Value
            R = UBound(sArr)
            ReDim dArr(1 To R, 1 To 1)
            For I = 1 To R
                If sArr(I, 1) <> Empty Then
                    Txt = sArr(I, 1)
                    If Dic.Exists(Txt) Then
                        dArr(I, 1) = ""
                    Else
                        dArr(I, 1) = Txt
                    End If
                End If
            Next I
        Set rng = .Range("D2")
        With rng
            .Resize(R) = dArr
            .Resize(R).Sort rng, xlAscending
        End With
    End With
End_:
    Set Dic = Nothing
End Sub

Cảm ơn Chị đã giúp đỡ ạ, nhưng code này không hoạt động ạ.. Khi em thay đổi giá trị.. Chẳng hạn là em để cho 02 danh sách giống nhau, khi chạy ra nó vẫn hiện ra project lỗi..

Bài đã được tự động gộp: 21/4/19

sao bạn k dùng công thức? countif là được mà

Cảm ơn Anh ạ, hiện em muốn dùng VBA để thao tác cho các File, nên em không dùng countif ạ.

 

[Hoàng Nhật Phương]

Cảm ơn Chị đã giúp đỡ ạ, nhưng code này không hoạt động ạ.. Khi em thay đổi giá trị.. Chẳng hạn là em để cho 02 danh sách giống nhau, khi chạy ra nó vẫn hiện ra project lỗi..

Bài đã được tự động gộp: 21/4/19

Cảm ơn Anh ạ, hiện em muốn dùng VBA để thao tác cho các File, nên em không dùng countif ạ.

Có thể do OT đang để:

Set rng = .Range("D2")

Nên C2:C3 vẫn còn kết quả.
Bạn thử sửa thành:

Set rng = .Range("C2")

Xem được không ạ?

 

[robinhsoon]

Có thể do OT đang để:

Set rng = .Range("D2")

Nên C2:C3 vẫn còn kết quả.
Bạn thử sửa thành:

Set rng = .Range("C2")

Xem được không ạ?

Em đã sửa lại rồi ạ, nhưng lần này kết quả vẫn sai ạ.. ví dụ: Project 377366 của cả 02 danh sách đều có, nhưng tool lại báo missing ạ.
Em có đính kèm File ạ

 

[Hoàng Nhật Phương]

Em đã sửa lại rồi ạ, nhưng lần này kết quả vẫn sai ạ.. ví dụ: Project 377366 của cả 02 danh sách đều có, nhưng tool lại báo missing ạ.
Em có đính kèm File ạ

Xin lỗi nhờ bạn sửa giúp chỗ:

For I = 2 To R
            Txt = sArr(I, 1)

thành:

For I = 1 To R
            Txt = sArr(I, 1)

 

[robinhsoon]

Xin lỗi nhờ bạn sửa giúp chỗ:

For I = 2 To R
            Txt = sArr(I, 1)

thành:

For I = 1 To R
            Txt = sArr(I, 1)

Em cảm ơn Chị OT, em làm được rồi ạ.. Chúc Chị sức khỏe và thành công ạ