Xin code lọc dữ liệu tự động theo đối tượng được chọn (1 người xem)

[hiepnh1985]

Em có File "Ho so" đính kèm. Em muốn tại ô O1 của Sheet "HanPaking" chỉ cần chọn tên giá đựng hồ sơ thì sẽ liệt kê ra danh mục hồ sơ chứa trong giá (giống như em đã filter copy sang ở bên dưới). Dữ liệu được lấy từ Sheet "GenData". Các bác có ai biết thì chỉ giúp em code để thực hiện nhé. Em cảm ơn nhiều.

 

[thanhsangnguyen1982]

Trong khi chờ các cao thủ ra tay thì bạn dùng code này
Nhấn Alt F11 , copy đoạn code dưới vào sheet Hanpacking
...............................
Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$O$1" Then
Range("A6:T65536").ClearContents
Sheets("GenData").Select
Sheets("GenData").Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=15, Criteria1:=Sheet2.Range("O1").Value
Sheets("GenData").Range("A2:A" & Sheets("GenData").Range("A65536").End(xlUp).Row).CurrentRegion.Select
Selection.Copy
Sheets("HanPacking").Select
Sheets("HanPacking").Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("GenData").Select
Sheets("GenData").Rows("1:1").Select
Selection.AutoFilter
Sheets("Hanpacking").Select
Sheets("HanPacking").Range("O1").Select
End If
End Sub

 

[hoamattroicoi]

Sub LocDL()
Dim i As Long, j As Long, k As Long
Dim sArr(), dArr()
sArr = Sheet12.Range("A2:T17").Value
ReDim dArr(1 To UBound(sArr), 1 To 20)
Sheet6.[A8:T100].ClearContents
    For i = 1 To UBound(sArr)
        If sArr(i, 15) = Sheet6.[O1] Then
            k = k + 1
            dArr(k, 1) = sArr(i, 1)
            For j = 5 To 20
                dArr(k, j) = sArr(i, j)
            Next
        End If
    Next
If k Then Sheet6.[A8].Resize(k, 20) = dArr
End Sub

 

[vodoi2x]

Sub LocDL()
Dim i As Long, j As Long, k As Long
Dim sArr(), dArr()
sArr = Sheet12.Range("A2:T17").Value
ReDim dArr(1 To UBound(sArr), 1 To 20)
Sheet6.[A8:T100].ClearContents
    For i = 1 To UBound(sArr)
        If sArr(i, 15) = Sheet6.[O1] Then
            k = k + 1
            dArr(k, 1) = sArr(i, 1)
            For j = 5 To 20
                dArr(k, j) = sArr(i, j)
            Next
        End If
    Next
If k Then Sheet6.[A8].Resize(k, 20) = dArr
End Sub

đổi 1 chút cho phức tạp hơn,

Sub LocDL2()
Dim i As Long, j As Long, k As Long
Dim sArr(), dArr1(), dArr16(), G
sArr = Sheet12.Range("A2:T17").Value
G = Sheet6.[O1]
ReDim dArr1(1 To UBound(sArr), 1 To 1)
ReDim dArr16(1 To UBound(sArr), 1 To 16)
Sheet6.[A8:T100].ClearContents
    For i = 1 To UBound(sArr)
        If sArr(i, 15) = G Then
            k = k + 1
            dArr1(k, 1) = sArr(i, 1)
            For j = 5 To 20
                dArr16(k, j - 4) = sArr(i, j)
            Next
        End If
    Next
If k Then Sheet6.[A8].Resize(k) = dArr1: Sheet6.[E8].Resize(k, 16) = dArr16
End Sub

 

[hiepnh1985]

Cảm ơn các bác đã giúp đỡ em nhé.

 

[nmhung49]

đổi 1 chút cho phức tạp hơn,

Vậy cũng phức tạp không kém nè

[GPECODE=vb]
Sub LocDL()
Dim i As Long, j As Long, k As Long
Dim sArr(), dArr()
sArr = Sheets("GenData").Range("A2:T17").Value
ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))


For i = 1 To UBound(sArr)
If sArr(i, 15) = Sheet6.[O1] Then
k = k + 1
For j = 1 To UBound(sArr, 2)
dArr(k, j) = sArr(i, j)
Next
End If
Next
With Sheets("HanPacking")
.[A8:T100].ClearContents
If k Then .[A8].Resize(k, UBound(sArr, 2)) = dArr
.[B8100].ClearContents
End With
End Sub


[/GPECODE]

 

[hiepnh1985]

Em chưa hiểu ý nghĩa của cái này . "If k" ở đây có nghĩa là gì vậy. Vì If chỉ đi với điều kiện đúng hay sai thôi mà.

 

[hiepnh1985]

If k Then Sheet6.[A8].Resize(k, 20) = dArr

Em chưa hiểu ý của "If k" là gì. Vì If phải đi cùng với đúng hay sai chứ nhỉ.

 

[dhn46]

Em chưa hiểu ý của "If k" là gì. Vì If phải đi cùng với đúng hay sai chứ nhỉ.

If k sẽ tương đương với

If k <> 0

Hoặc

If k <> False