Lọc và thêm mới vào danh sách (1 người xem)

[vanlinh_2904]

Chào các bạn! Mình có sheet "NKBH" nhật ký bán hàng của NV trong tháng, và 1 sheet "TH" là tổng hợp DS nhân viên bán hàng, Mình nhờ các bạn viết giúp VBA mỗi khi đánh nhân viên mới vào sheet "NKBH" thì sẽ dò tìm bên DS nhân viên sheet "TH" chưa có thì chèn thêm vào sheet "TH".cảm ơn các bạn nhiều.

 

[ndu96081631]

Chào các bạn! Mình có sheet "NKBH" nhật ký bán hàng của NV trong tháng, và 1 sheet "TH" là tổng hợp DS nhân viên bán hàng, Mình nhờ các bạn viết giúp VBA mỗi khi đánh nhân viên mới vào sheet "NKBH" thì sẽ dò tìm bên DS nhân viên sheet "TH" chưa có thì chèn thêm vào sheet "TH".cảm ơn các bạn nhiều.

Cho code dưới đây vào sheet TH nhé:

Private Sub Worksheet_Activate()
  Dim SrcRng As Range
  Set SrcRng = Sheets("NKBH").Range("A4:D10000")
  SrcRng.AdvancedFilter 2, , Range("B5:D5"), True
End Sub

 

[Ba Tê]

Cho code dưới đây vào sheet TH nhé:

Private Sub Worksheet_Activate()
  Dim SrcRng As Range
  Set SrcRng = Sheets("NKBH").Range("A4:D10000")
  SrcRng.AdvancedFilter 2, , Range("B5:D5"), True
End Sub

Code quá ngắn gọn. Tuyệt!
Nhưng mà, hình như tác giả muốn: Sheet TH đã có ds nhiều nhân viên rồi, nếu nhập thêm một nhân viên vào sheet NKBH mà chưa có tên bên sheet TH thì mới thêm vào. Như vậy, nếu Ad_Filter sẽ bỏ hết ds cũ bên sheet TH, lấy DS duy nhất bên sheet NKBH qua sheet TH sao ta?
Kệ, làm thí thí theo kiểu mình hiểu, luyện viết mảng trong VBA luôn.
Ẹc...

Public Sub GPE()
Dim Rng(), Arr(1 To 65000, 1 To 3), Dic As Object, I As Long, J As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
    Rng = Sheets("TH").[B6:B65000].Value
    For I = 1 To UBound(Rng, 1)
            Tem = Rng(I, 1)
        If Tem <> "" Then
            If Not Dic.Exists(Tem) Then
                Dic.Add Tem, ""
            End If
        End If
    Next I
    Rng = Sheets("NKBH").[B5:D65000].Value
    For I = 1 To UBound(Rng, 1)
            Tem = Rng(I, 1)
        If Tem <> "" Then
            If Not Dic.Exists(Tem) Then
                Dic.Add Tem, ""
                K = K + 1
                For J = 1 To 3
                    Arr(K, J) = Rng(I, J)
                Next J
            End If
        End If
    Next I
    If K Then Sheets("TH").[B65000].End(xlUp).Offset(1).Resize(K, 3).Value = Arr
Set Dic = Nothing
End Sub

 

[vanlinh_2904]

Cho code dưới đây vào sheet TH nhé:

Private Sub Worksheet_Activate()
  Dim SrcRng As Range
  Set SrcRng = Sheets("NKBH").Range("A4:D10000")
  SrcRng.AdvancedFilter 2, , Range("B5:D5"), True
End Sub

Anh ơi, em đã copy đoạn code vào vào sheet TH nhưng bị xoá danh sách cũ đi, em muốn giữ nguyên danh sách ở sheet TH và chỉ thêm mới những DS chưa có thôi.em cảm ơn anh

 

[ndu96081631]

Anh ơi, em đã copy đoạn code vào vào sheet TH nhưng bị xoá danh sách cũ đi, em muốn giữ nguyên danh sách ở sheet TH và chỉ thêm mới những DS chưa có thôi.em cảm ơn anh

Tại tôi hiểu sai ý bạn!
Nếu bạn dùng Office 2003 thì có thể dùng code của Ba Tê
Nếu dùng Office 2007 hoặc 2010 thì dùng cái này:

Private Sub Worksheet_Activate()
  Dim SrcRng As Range, Target As Range
  Set SrcRng = Sheets("NKBH").Range("B4:D10000")
  Set Target = Range("B60000").End(xlUp).Offset(1)
  SrcRng.AdvancedFilter 2, , Target, True
  Range("B5:D10000").RemoveDuplicates Array(1, 2, 3), xlNo
End Sub