Nhờ giúp tham chiếu, trích xuất dữ liệu

[illicitawakening]

Chào các bạn! Mình có 1 file gửi đính kèm nhờ các bạn giúp đỡ. File bao gồm nhiều dòng dữ liệu. Yêu cầu là khi đánh điều kiện (tên hàng) vào 1 cell nhất định thì tất cả dữ liệu liên quan đến mặt hàng đó sẽ được trích xuất ra phía dưới 1 cách tự động. Nói hơi khó hiểu mọi người xem file sẽ dễ hiểu hơn. Cái này làm bằng data filter hoặc pivot table thì đơn giản nhưng do nhu cầu đặc biệt nên mới phải làm theo cách rắc rồi mình yêu cầu. Mọi người giúp mình nha, thanks.

 

[buithinhvan77]

Mình thường lọc bằng cách này!

 

[hoamattroicoi]

Mình thì thường làm thế này, bạn xem file đính kèm nhé:

 

[ChanhTQ@]

Hai cách trên rất hay, nếu người dùng là trong ngành; Vì lúc đó họ sẽ biết số dòng cực đại dành cho các công thức dò tìm

Sao HMTC không thử tay nghề với các câu lệnh macro đã tu nghiệp được bấy nay xem sao?!

 

[illicitawakening]

Cám ơn 2 bạn buithinhvan77 và hoamattroicoi rất nhiều, 2 bạn hướng dẫn mình cách làm luôn nha, thanks !!!

 

[hoamattroicoi]

Hai cách trên rất hay, nếu người dùng là trong ngành; Vì lúc đó họ sẽ biết số dòng cực đại dành cho các công thức dò tìm
Sao HMTC không thử tay nghề với các câu lệnh macro đã tu nghiệp được bấy nay xem sao?!

Hic, cuối năm công việc bận bù đầu, tranh thủ buổi trưa ngó vô TOPC thấy đề nghị của bác ChanhTQ hay quá nên HMTc làm thử bài này bằng VBA. Kiến thức VBA của HMTc còn ngu ngơ lắm, HMTc đang nghiên cứu mảng VBA và vòng FOR, Function nên làm thử bài này theo cách đó coi thế nào! Nhờ các sư phụ sửa giúp HMTc.
Xin chân thành cảm ơn!

CODE Cập nhật mã :

Sub UniqueHMT()
Dim ArSource, ArrDes
Dim i As Long
Dim k As Long
Dim n As Long

ArSource = Range([A3], Cells(Cells.Rows.Count, 1).End(xlUp)).Value
n = UBound(ArSource, 1)
ReDim ArrDes(1 To n, 1 To 1)

    ArrDes(1, 1) = ArSource(1, 1)
    k = 1
    For i = 2 To n
        If Not isInOrEmpty(ArSource(i, 1), ArrDes, 1, k) Then
            k = k + 1
            ArrDes(k, 1) = ArSource(i, 1)
        End If
    Next i
            Range("H3").Resize(k).Value = ArrDes
     
End Sub

Public Function isInOrEmpty(x, aA, p As Long, q As Long) As Boolean
Dim kQ As Boolean, i As Long
If IsEmpty(x) Then kQ = True: GoTo 1
kQ = False
For i = p To q
    If x = aA(i, 1) Then
        kQ = True
        Exit For
    End If
Next i
1:
    isInOrEmpty = kQ
    End Function

CODE Loc

Sub Loc()
    Dim k As Long
    
    Application.ScreenUpdating = False
    Sheet2.Range("A4:D500").ClearContents
    k = 4
    eR = Sheet1.Range("A65536").End(xlUp).Row
    For i = 3 To eR
    If Sheet1.Cells(i, 1).Value = Sheet2.[B1].Value Then
        Sheet2.Cells(k, 1).Value = Sheet1.Cells(i, 1).Value
        Sheet2.Cells(k, 2).Value = Sheet1.Cells(i, 2).Value
        Sheet2.Cells(k, 3).Value = Sheet1.Cells(i, 3).Value
        Sheet2.Cells(k, 4).Value = Sheet1.Cells(i, 4).Value
        k = k + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub

 

[ptm0412]

Sub Loc() làm bằng Array luôn cho hoành tráng đi Còi!
Còn cái UniqueHMT và cái Function IsInOrEmpty cả 2 cái gộp lại  thành 1 Sub dùng Dic cho oai.

 

[hoamattroicoi]

Sub Loc() làm bằng Array luôn cho hoành tráng đi Còi!
Còn cái UniqueHMT và cái Function IsInOrEmpty cả 2 cái gộp lại thành 1 Sub dùng Dic cho oai.

Em mạo muội làm thử Loc() bằng Array xem sao?

Sub TestArr()
Dim sArr, dArr, i As Long, j As Long, k As Long
Dim m As Integer, n As Integer
Dim sh0 As Worksheet
Dim sh1 As Worksheet
Set sh0 = Sheets("DuLIeuGoc")
Set sh1 = Sheets("KQ")

sh1.Range("A4:D100").ClearContents
With sh0
sArr = .Range("A3", .[D65536].End(xlUp)).Value
End With
m = UBound(sArr, 1)
n = UBound(sArr, 2)
ReDim dArr(1 To m, 1 To n)
For i = 1 To m
    If sArr(i, 1) = sh1.[B1].Value Then
        k = k + 1
        For j = 1 To n
            dArr(k, j) = sArr(i, j)
        Next
    End If
Next
Sh1.[A4].Resize(k, n) = dArr
End Sub

Cái vụ lọc duy nhất dùng DIC thì bác CÒ, sư phụ và sư phụ ndu làm quá nhiều rồi!

 

[tuyetlan.nong]

mình có file như thế này mà k thể lọc gióng các bạn được , các bạn giúp mình cách tải file lên với

 

[hoamattroicoi]

Sub Loc() làm bằng Array luôn cho hoành tráng đi Còi! Còn cái UniqueHMT và cái Function IsInOrEmpty cả 2 cái gộp lại thành 1 Sub dùng Dic cho oai.

Em thử làm cái này bằng AutoFilter, riêng cái UniqueHMT đã thử với DIC, nhờ các sư phụ sửa CODE dùm em!
Xin chân thành cảm ơn!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh0 As Worksheet
Set sh0 = Sheets("DuLIeuGoc")

If Target.Address = "$B$1" Then
        Range("A4:D1000").Clear
        With sh0.Range(sh0.[A2], sh0.[A65536].End(xlUp)).Resize(, 4)
            .AutoFilter 1, [B1]
            .SpecialCells(12).Copy [A3]
            .AutoFilter
        End With
            Range("A3", [A65536].End(xlUp)).Resize(, 4).Borders.LineStyle = 1
    End If
    
End Sub

 

[ptm0412]

Vậy mới là phải phải chứ. Không hổ danh trò nhà chết tiệt.

 

[tuyetlan.nong]

ban haomattroicoi ơi mình thấy cách của bạn hay nhưng mình k hiểu lắm ô UPDATE là gì vậy bận

 

[ptm0412]

Ô update tạo ra 1 danh sách mã ở cột F sheet gốc (cột F đã bị dấu)
Nếu thêm mã, nhấn nút này sẽ cập nhật mã mới vào DS cho cái validation.

 

[tuyetlan.nong]

bạn hoamattroicoi ơi bạn chỉ cho mình cách tải file mẫu lên với mình có 1 file cần hỏi các bạn mà k biết tải lên ntn, mình còn kém về vi tính lắm, thanks

 

[hoamattroicoi]

tuyetlan.nong xem link này nhé!
http://www.giaiphapexcel.com/forum/showthread.php?33633-Hướng-dẫn-gửi-bài-và-đính-kèm-tập-tin