Lọc dữ liệu giữa hai sheets và thay thế dữ vừa lọc bằng dữ liêu mới (1 người xem)

[dtaphuong]

Trong file mình có 2 sheets: 1 sheet là dữ liệu cũ; 1 sheet là dữ liệu mới. Mình có 2 vấn đề nhờ mọi người giúp dùm

1.
Dữ liệu mới = Dữ liệu thêm vào (Note lại là NEW) + Dữ liệu còn lại (Dữ liệu trùng với Dữ liệu cũ)

Dữ liệu cũ = Dữ liệu còn lại + Dữ liệu hết hạn (Note lại là OLD)

Nhờ mọi người giúp đỡ mình cách lọc ra được Dữ liệu thêm vào và Dữ liệu hết hạn.

Dữ liệu thêm vào là những hợp đồng không trùng với dữ liệu cũ
Dữ liệu hết hạn là những hợp đồng không trùng với dữ liệu mới

2. Sau khi dữ liệu được tách ra thì đối với "Dữ liệu thêm vào" được note là NEW thì sẽ thay bằng tên nhân viên phụ trách theo các ưu tiên sau:

Ưu tiên 1: Đối với khách hàng có hộ khẩu tạm trú trùng với bảng khu vực trong sheet "Khu vực" thì sẽ hiện ra tên nhân viên tương ứng

Ưu tiên 2: Đối với những khách hàng mà hộ khẩu tạm trú mà không trùng thì sẽ xem tiếp đến hộ khẩu thường trú, nếu trùng với "Khu vực" thì sẽ hiện ra nhân viên tương ứng

Ưu tiên 3: nếu không đủ 2 điều kiện trên thì sẽ vẫn ghi là "NEW"


Bình thường những cái này mình sẽ dùng vlookup qua lại giữa 2 sheet Dữ liệu mới và cũ để lọc ra danh sách. Sau khi có danh sách đó thì mình dùng if và vlookup để lọc ra tên nhân viên tương ừng khu vực

Vì làm đi làm lại nhiều lần quá với dữ liệu lớn nên mình nhờ mọi người giúp mình viết code VBA để có thể làm nhanh hơn

Cám ơn mọi người đã đọc bài.

 

[doveandrose]

đọc thì có đọc rồi nhưng còn file đâu ? bài này có file rồi chắc cũng cãi nhau còn chán rồi mới viết ra code ấy chứ

 

[dtaphuong]

Gửi lại mọi người file đính kèm

 

[doveandrose]

Tôi đọc rồi.........mà tôi hiểu được bạn nói gì tôi chết liền!

muốn hiểu được bài này là phải làm vài lon 33 may ra

Public Sub hello()
Dim arrOLD As Variant, arrNEW As Variant, lr As Long, rsOLD As Variant, r As Long
Dim Dic As Object, rsNEW As Variant, dicKV As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set dicKV = CreateObject("Scripting.Dictionary")
lr = Sheet1.[A1000000].End(xlUp).Row
arrOLD = Sheet1.Range("A2:A" & lr).Value
ReDim rsOLD(1 To UBound(arrOLD), 1 To 1)
For r = 1 To UBound(arrOLD) Step 1
    rsOLD(r, 1) = "OLD"
    Dic(arrOLD(r, 1)) = r
Next
lr = Sheet4.[A1000000].End(xlUp).Row
For r = 2 To lr Step 1
    dicKV(LCase(Sheet4.Range("A" & r).Value)) = Sheet4.Range("B" & r).Value
Next
lr = Sheet2.[A1000000].End(xlUp).Row
arrNEW = Sheet2.Range("A2:D" & lr).Value
ReDim rsNEW(1 To UBound(arrNEW), 1 To 1)
For r = 1 To UBound(arrNEW) Step 1
    rsNEW(r, 1) = "NEW"
    If Dic.exists(arrNEW(r, 1)) Then
        rsOLD(Dic(arrNEW(r, 1)), 1) = "Con lai"
        rsNEW(r, 1) = "Con lai"
    Else
        If dicKV.exists(LCase(arrNEW(r, 4))) Then
            rsNEW(r, 1) = dicKV(LCase(arrNEW(r, 4)))
        Else
            If dicKV.exists(LCase(arrNEW(r, 3))) Then rsNEW(r, 1) = dicKV(LCase(arrNEW(r, 3)))
        End If
    End If
Next
Sheet1.Range("B2").Resize(UBound(rsOLD)).Value = rsOLD
Sheet2.Range("B2").Resize(UBound(rsNEW)).Value = rsNEW
End Sub

 

[dtaphuong]

muốn hiểu được bài này là phải làm vài lon 33 may ra

Public Sub hello()
Dim arrOLD As Variant, arrNEW As Variant, lr As Long, rsOLD As Variant, r As Long
Dim Dic As Object, rsNEW As Variant, dicKV As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set dicKV = CreateObject("Scripting.Dictionary")
lr = Sheet1.[A1000000].End(xlUp).Row
arrOLD = Sheet1.Range("A2:A" & lr).Value
ReDim rsOLD(1 To UBound(arrOLD), 1 To 1)
For r = 1 To UBound(arrOLD) Step 1
    rsOLD(r, 1) = "OLD"
    Dic(arrOLD(r, 1)) = r
Next
lr = Sheet4.[A1000000].End(xlUp).Row
For r = 2 To lr Step 1
    dicKV(LCase(Sheet4.Range("A" & r).Value)) = Sheet4.Range("B" & r).Value
Next
lr = Sheet2.[A1000000].End(xlUp).Row
arrNEW = Sheet2.Range("A2:D" & lr).Value
ReDim rsNEW(1 To UBound(arrNEW), 1 To 1)
For r = 1 To UBound(arrNEW) Step 1
    rsNEW(r, 1) = "NEW"
    If Dic.exists(arrNEW(r, 1)) Then
        rsOLD(Dic(arrNEW(r, 1)), 1) = "Con lai"
        rsNEW(r, 1) = "Con lai"
    Else
        If dicKV.exists(LCase(arrNEW(r, 4))) Then
            rsNEW(r, 1) = dicKV(LCase(arrNEW(r, 4)))
        Else
            If dicKV.exists(LCase(arrNEW(r, 3))) Then rsNEW(r, 1) = dicKV(LCase(arrNEW(r, 3)))
        End If
    End If
Next
Sheet1.Range("B2").Resize(UBound(rsOLD)).Value = rsOLD
Sheet2.Range("B2").Resize(UBound(rsNEW)).Value = rsNEW
End Sub

Cám ơn doveandrose nha. Mình đã làm được rồi.
Trong đoạn code của bạn mình cũng hiểu hơi hơi nhưng mà cho mình hỏi đoạn code này có ý nghĩa gì vậy?

ReDim rsOLD(1 To UBound(arrOLD), 1 To 1)
For r = 1 To UBound(arrOLD) Step 1
rsOLD(r, 1) = "OLD"
Dic(arrOLD(r, 1)) = r
Next
lr = Sheet4.[A1000000].End(xlUp).Row
For r = 2 To lr Step 1
dicKV(LCase(Sheet4.Range("A" & r).Value)) = Sheet4.Range("B" & r).Value
Next
lr = Sheet2.[A1000000].End(xlUp).Row

 

[doveandrose]

thì để gắn chữ "OLD" vào cột B sheet "dữ liệu cũ" thôi chứ có gì đâu