Xin giúp đỡ code VBA để lọc danh sách (1 người xem)

[zenphone]

Dear các anh/chị.
Mình đang muốn lọc danh sách theo 1 đối tượng, khi chọn 1 đối tượng nào đó thì tất cả dữ liệu của đối tượng đó sẽ liệt kê ra 1 bảng tại 1 sheet khác.
Mình xin giúp đỡ file này bằng code VBA, đây chỉ là dữ liệu mô phỏng thôi. mình sẽ áp dụng vào việc khác.

Thanks nhiều

 

[mhieuit]

Dear các anh/chị.
Mình đang muốn lọc danh sách theo 1 đối tượng, khi chọn 1 đối tượng nào đó thì tất cả dữ liệu của đối tượng đó sẽ liệt kê ra 1 bảng tại 1 sheet khác.
Mình xin giúp đỡ file này bằng code VBA, đây chỉ là dữ liệu mô phỏng thôi. mình sẽ áp dụng vào việc khác.

Thanks nhiều

Bạn xem có đúng ý của bạn không nhé

 

[hoamattroicoi]

Dear các anh/chị.
Mình đang muốn lọc danh sách theo 1 đối tượng, khi chọn 1 đối tượng nào đó thì tất cả dữ liệu của đối tượng đó sẽ liệt kê ra 1 bảng tại 1 sheet khác.
Mình xin giúp đỡ file này bằng code VBA, đây chỉ là dữ liệu mô phỏng thôi. mình sẽ áp dụng vào việc khác.

Thanks nhiều

Dữ liệu mô phỏng nên mình viết code mô phỏng vậy.

Sub LocDuLieu()
Dim i As Long, k As Long, j As Long
Dim sArr(), dArr()
sArr = Sheet2.Range("A2:D" & Sheet2.[D65536].End(xlUp).Row).Value
ReDim dArr(1 To UBound(sArr), 1 To 5)


For i = 1 To UBound(sArr)
    If sArr(i, 1) = Sheet1.[H3].Value Then
        k = k + 1
        dArr(k, 1) = k
        For j = 2 To 5
            dArr(k, j) = sArr(i, j - 1)
        Next
    End If
Next


[A8:F10000].ClearContents
[A8].Resize(k, 5) = dArr
End Sub
'================================================Dont ask me any question relate to this code, kekeee
Sub Addvalidation()
Dim sArr, Item, Dic As Object, tmp As String
sArr = Sheet2.Range("A2:A10000").Value
Set Dic = CreateObject("Scripting.Dictionary")
For Each Item In sArr
    If Len(Item) Then
        Dic(Item) = ""
    End If
    Next
With Sheet1.[H3].Validation
    .Delete
    If Dic.Count Then .Add 3, , , Join(Dic.Keys, ",")
End With

 

[SA_DQ]

Thêm cho bạn 1 tham khảo, xài macro sự kiện