Nhờ giúp đỡ tạo hàm lọc dữ liệu (4 người xem)

[tenluahanhtrinh]

Chào các anh chị trên diễn đàn.
Công việc của em phải xử lý một khối lượng lớn dữ liệu nên rất mất thời gian. Do vậy em có ý tưởng về 1 hàm mới nhưng lại không biết gì về code.
Vậy nên em nhờ anh chị trên diễn đàn giúp em tạo hàm lọc ra những giá trị duplicate.
Hơi khó trình bày nên anh chị vui lòng xem file đính kèm nhé.

Em cảm ơn các anh chị nhiều.

 

[SA_DQ]

Bạn xem file; Mình làm hàm mảng tự tạo

 

[tenluahanhtrinh]

Bạn xem file; Mình làm hàm mảng tự tạo

Cảm ơn bạn đã giúp đỡ
Nếu có thời gian, bạn xem lại giúp mình 1 chút nữa nhé. Cụ thể là mình thêm dữ liệu vào dự án 2 thì nó vẫn gộp list chung luôn với dự án 1.
Mình cảm ơn nhiều

 

[Let'GâuGâu]

Cảm ơn bạn đã giúp đỡ
Nếu có thời gian, bạn xem lại giúp mình 1 chút nữa nhé. Cụ thể là mình thêm dữ liệu vào dự án 2 thì nó vẫn gộp list chung luôn với dự án 1.
Mình cảm ơn nhiều

sao tôi đọc chẳng hiểu gì hết, sao mấy cái "tính chất...1...2...3" chỉ có đến dòng số 10?
(hết dự án 1?)
vậy dự án 2, 3 làm gì có tính chất nào?

 

[tenluahanhtrinh]

sao tôi đọc chẳng hiểu gì hết, sao mấy cái "tính chất...1...2...3" chỉ có đến dòng số 10?
(hết dự án 1?)
vậy dự án 2, 3 làm gì có tính chất nào?

Vì là dữ liệu mẫu nên mình chưa có nhập vào hết bạn à

 

[Let'GâuGâu]

Vì là dữ liệu mẫu nên mình chưa có nhập vào hết bạn à

thử đoạn code sau

Sub chuahieulam()
Dim arr, kq(1 To 6000, 1 To 2) As Variant, i, j, k As Long, d As Object
arr = Range([a2], [a2].End(xlDown)).Resize(, 4).Value

For i = 1 To UBound(arr)
    If arr(i, 1) = [h2] Then
        If IsEmpty(kq(Val(Right(arr(i, 3), 1)), 1)) Then
            kq(Val(Right(arr(i, 3), 1)), 1) = arr(i, 3)
            kq(Val(Right(arr(i, 3), 1)), 2) = arr(i, 2)
        Else
            kq(Val(Right(arr(i, 3), 1)), 2) = kq(Val(Right(arr(i, 3), 1)), 2) & "," & arr(i, 2)
        End If
        If IsEmpty(kq(Val(Right(arr(i, 4), 1)), 1)) Then
            kq(Val(Right(arr(i, 4), 1)), 1) = arr(i, 4)
            kq(Val(Right(arr(i, 4), 1)), 2) = arr(i, 2)
        Else
            kq(Val(Right(arr(i, 4), 1)), 2) = kq(Val(Right(arr(i, 4), 1)), 2) & "," & arr(i, 2)
        End If
    End If
Next
 
[h11].Resize(UBound(kq), 2) = kq

End Sub

à quên H2 là tên dự án nha

 

[SA_DQ]

Nếu có thời gian, bạn xem lại giúp mình 1 chút nữa nhé. Cụ thể là mình thêm dữ liệu vào dự án 2 thì nó vẫn gộp list chung luôn với dự án 1.
Mình cảm ơn nhiều

Bạn lấy cái này chép đè lên toàn bộ cái cũ; Chắc là được:

Option Explicit
Function LietKe(Rng As Range, DAn As String)
 Dim Dic As Object, Arr(), Cls As Range, Cll As Range
 Dim J As Byte, Tmp$
 
 Set Dic = CreateObject("Scripting.Dictionary")
 ReDim Arr(1 To 6, 1 To 2)
 For Each Cls In Rng(3).Resize(Rng.Rows.Count, 2)
    If Not Dic.Exists(Cls.Value) Then
        J = J + 1
        Arr(J, 1) = Cls.Value
        Dic.Add (Cls.Value), J
    End If
 Next Cls
 For J = 1 To UBound(Arr())
    If Len(Arr(J, 1)) Then
        For Each Cls In Rng(3).Resize(Rng.Rows.Count, 2)
            If Cls.Value = Arr(J, 1) And Cells(Cls.Row, "A").Value = DAn Then   '<=|'
                Tmp = Tmp & ", " & Cells(Cls.Row, 2).Value
            End If
        Next Cls
    Else
        Exit For
    End If
    If Len(Tmp) Then
        Arr(J, 2) = Mid(Tmp, 3, Len(Tmp))
        Tmp = ""
    End If
 Next J
 LietKe = Arr()
End Function

 

[tenluahanhtrinh]

Bạn lấy cái này chép đè lên toàn bộ cái cũ; Chắc là được:

Cảm ơn bạn nhé, cái mới chạy tốt bạn à(hình như chỉ giới hạn 4 ghi chú khác nhau và chỉ chạy trên 2 cột ghi chú, nhưng nói chung chạy tốt ). Chỉ có điều bây giờ mình copy cái lệnh đó qua sheet khác nó lại không chạy, lạ thật

 

[tenluahanhtrinh]

thử đoạn code sau

Sub chuahieulam()
Dim arr, kq(1 To 6000, 1 To 2) As Variant, i, j, k As Long, d As Object
arr = Range([a2], [a2].End(xlDown)).Resize(, 4).Value

For i = 1 To UBound(arr)
    If arr(i, 1) = [h2] Then
        If IsEmpty(kq(Val(Right(arr(i, 3), 1)), 1)) Then
            kq(Val(Right(arr(i, 3), 1)), 1) = arr(i, 3)
            kq(Val(Right(arr(i, 3), 1)), 2) = arr(i, 2)
        Else
            kq(Val(Right(arr(i, 3), 1)), 2) = kq(Val(Right(arr(i, 3), 1)), 2) & "," & arr(i, 2)
        End If
        If IsEmpty(kq(Val(Right(arr(i, 4), 1)), 1)) Then
            kq(Val(Right(arr(i, 4), 1)), 1) = arr(i, 4)
            kq(Val(Right(arr(i, 4), 1)), 2) = arr(i, 2)
        Else
            kq(Val(Right(arr(i, 4), 1)), 2) = kq(Val(Right(arr(i, 4), 1)), 2) & "," & arr(i, 2)
        End If
    End If
Next
 
[h11].Resize(UBound(kq), 2) = kq

End Sub

à quên H2 là tên dự án nha

Cảm ơn bạn, nhưng mình không biết nhập code của bạn vào đâu, hic.
Nếu như Ghi chú chỉ có 1 cột thì mình làm theo cách này cũng được http://www.giaiphapexcel.com/forum/showthread.php?97760-Nối-chuỗi-theo-điều-kiện . Nhưng ở đây có nhiều cột nên chịu, trước giờ cứ làm bằng tay lâu quá. Mong mọi người giúp đỡ.

 

[SA_DQ]

Cảm ơn bạn nhé, cái mới chạy tốt bạn à(hình như chỉ giới hạn 4 dòng tính chất khác nhau và chỉ chạy trên 2 cột ghi chú, nhưng nói chung chạy tốt ). Chỉ có điều bây giờ mình copy cái lệnh đó qua sheet khác nó lại không chạy, lạ thật

Đó là hàm mảng tự tạo; Với nó ta cần lưu í sau:

(1) Không thể chỉ thay đổi 1 vài ô chứa hàm; mà fải thay toàn vùng;

(2) Muốn nó khảo sát cả 4 cột ghi chú thì viết lại hàm tự tạo;
Cũng như thế nếu muốn tăng hơn 4 tính chất khác nhau.

(3) Nếu muốn tổng quát cho mọi trường hợp bạn cần đưa lại số liệu đầy đủ; Nhất là số tính chất tối đa (hiện đang là 3) & số cột ghi chú tối đa (hiện đang là 2)

(4) Muốn xài ở file khác, bạn cần chép nội dung hàm sang file í;
Ngoài ra xin lưu í đó là hàm mảng. Vậy nên fải kết thúc bỡi tổ hợp 3 fím giành cho hàm mảng.

Chúc tuần làm việc vui vẻ & nhiều thành tựu!

 

[tenluahanhtrinh]

Đó là hàm mảng tự tạo; Với nó ta cần lưu í sau:

(1) Không thể chỉ thay đổi 1 vài ô chứa hàm; mà fải thay toàn vùng;

(2) Muốn nó khảo sát cả 4 cột ghi chú thì viết lại hàm tự tạo;
Cũng như thế nếu muốn tăng hơn 4 tính chất khác nhau.

(3) Nếu muốn tổng quát cho mọi trường hợp bạn cần đưa lại số liệu đầy đủ; Nhất là số tính chất tối đa (hiện đang là 3) & số cột ghi chú tối đa (hiện đang là 2)

(4) Muốn xài ở file khác, bạn cần chép nội dung hàm sang file í;
Ngoài ra xin lưu í đó là hàm mảng. Vậy nên fải kết thúc bỡi tổ hợp 3 fím giành cho hàm mảng.

Chúc tuần làm việc vui vẻ & nhiều thành tựu!

Cảm ơn bạn, hiện tại dữ liệu cũng chỉ có chừng đó thôi bạn à.

 

[tenluahanhtrinh]

Bạn HYen17 có thể giúp mình sửa lại code hôm bạn viết giúp mình thêm một chút được không ạ.
Mình mới phát hiện ra vân đề là nếu câu note không nằm ở Dự án 1 thì lúc liệt kê Dự án 2 nó sẽ không xuất hiện. Bạn sửa giúp mình nhé. Cảm ơn bạn nhiều

 

[SA_DQ]

Bạn sửa dòng lệnh thành vậy là được:

    If Not Dic.Exists(Cls.Value) And Cls.Value <> "" Then

 

[tenluahanhtrinh]

Bạn sửa dòng lệnh thành vậy là được:

    If Not Dic.Exists(Cls.Value) And Cls.Value <> "" Then

Cảm ơn bạn nhiều nhé