Viết dùm đoạn code lọc dữ liệu !

[laianhtu]

Xin chào các bạn,

Mình có dữ liệu "Database" chứa dữ liệu nhân viên nhưng có mã nhân viên và tên nhân viên trùng nhau trên cùng nhiều dòng. Thay vì mình lọc dữ liệu nhân viên bất kỳ và chép sang một sheet mới để có mã và tên nhân viên không trùng nhau, sau đó dùng công thức để tính tổng cộng mã nhân viên từ "Database".

Có ai biết đoạn code để lấy dữ liệu mã nhân viên và tên nhân viên sang sheet!Ketqua.

Thanks.
Anh Tú.

"Love is beautiful when it's unconclusive".

 

[ndu96081631]

Xin chào các bạn,

Mình có dữ liệu "Database" chứa dữ liệu nhân viên nhưng có mã nhân viên và tên nhân viên trùng nhau trên cùng nhiều dòng. Thay vì mình lọc dữ liệu nhân viên bất kỳ và chép sang một sheet mới để có mã và tên nhân viên không trùng nhau, sau đó dùng công thức để tính tổng cộng mã nhân viên từ "Database".

Có ai biết đoạn code để lấy dữ liệu mã nhân viên và tên nhân viên sang sheet!Ketqua.

Thanks.
Anh Tú.

"Love is beautiful when it's unconclusive".

Mấy vụ lọc trùng này dùng Advanced Filter là nhanh gọn nhất ---> Bạn thử xem ---> Thao tác trong vòng 10s

 

[laianhtu]

Chào bạn,

Ý mình là dùng đoạn code nào để tách lọc dữ liệu kìa. ví dụ: có 4 dòng có tên nv A, B, C,A trên cùng 4 dòng. Mình muốn làm đoạn code sẽ ra kết quả là 3 nhân viên A, B, C trên 3 dòng của một sheet khác (vì có tên nhân viên A trùng nhau).

Bạn làm thế nào ? nếu mình filter rồi copy nhân vien A và paste từng nhân viên A hoặc B, C thì nếu dữ liệu có 1000 dòng có trên 100 nhân viên trùng tên thì sẽ filter và paste 100 dòng à ?

Thanks.
Anh Tú
"Love is beautiful when it's unconclusive".

 

[ChanhTQ@]

Đoạn Code như thế này trên GPE rất nhiều, tại bạn ngại tìm thôi

Option Explicit
Sub CopyUniqueList()
 Dim eRw As Long:                       Dim Sh As Worksheet
 Dim Rng As Range, sRng As Range, Clls As Range
 
 Sheets("Database").Select
 eRw = [a65500].End(xlUp).Row:          Set Rng = Range("A6:A" & eRw)
 Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("IA6"), Unique:=True
 Set Sh = Sheets("KQua")
 Sh.Range("A5:B" & eRw).Clear
 For Each Clls In Range([ia7], [ia7].End(xlDown))
    Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then _
        Sh.[a65500].End(xlUp).Offset(1).Resize(, 2).Value = sRng.Resize(, 2).Value
 Next Clls
 Range("IA1:IA" & eRw).Clear:           Sh.Select
 With [a4]
    eRw = .Interior.ColorIndex
    If eRw > 41 Then eRw = 34
    .Resize(, 2).Interior.ColorIndex = eRw + 1
 End With
End Sub

Thêm tí màu mè cho vui mắt!

 

[ndu96081631]

Option Explicit
Sub CopyUniqueList()
 Dim eRw As Long:                       Dim Sh As Worksheet
 Dim Rng As Range, sRng As Range, Clls As Range
 
 Sheets("Database").Select
 eRw = [a65500].End(xlUp).Row:          Set Rng = Range("A6:A" & eRw)
 Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("IA6"), Unique:=True
 Set Sh = Sheets("KQua")
 Sh.Range("A5:B" & eRw).Clear
 For Each Clls In Range([ia7], [ia7].End(xlDown))
    Set sRng = Rng.Find(Clls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then _
        Sh.[a65500].End(xlUp).Offset(1).Resize(, 2).Value = sRng.Resize(, 2).Value
 Next Clls
 Range("IA1:IA" & eRw).Clear:           Sh.Select
 With [a4]
    eRw = .Interior.ColorIndex
    If eRw > 41 Then eRw = 34
    .Resize(, 2).Interior.ColorIndex = eRw + 1
 End With
End Sub

Thêm tí màu mè cho vui mắt!

Sư phụ ơi, em nghĩ chỉ cần thế này thôi:

Sub CopyUniqueList()
  Sheet2.Range("A4").CurrentRegion.Clear
  With Sheet1.Range(Sheet1.[A6], Sheet1.[B65536].End(xlUp))
    .AdvancedFilter 2, , Sheet2.[A4], True
  End With
End Sub