Tìm kiếm bằng VBA

[tranphuson]

Vui lòng giúp mình khi tìm mã nhà cung cấp thì trích lọc như file nội dung bên dưới

Ví dụ: Chọn mã Nhà cung cấp ở Cột E dòng 1 - thì tự động Liệt kê dựa theo nội dung bên dưới dựa theo dữ liệu từ Cột A đến Cột L từ dòng 11 trở xuống

Cảm ơn

 

[snow25]

Vui lòng giúp mình khi tìm mã nhà cung cấp thì trích lọc như file nội dung bên dưới

Ví dụ: Chọn mã Nhà cung cấp ở Cột E dòng 1 - thì tự động Liệt kê dựa theo nội dung bên dưới dựa theo dữ liệu từ Cột A đến Cột L từ dòng 11 trở xuống

Cảm ơn

Bạn bố trí cái data vớ vẩn thế.Nếu nó nhiều quá thì làm thế nào.

 

[nhamvantrieu]

Bạn bố trí cái data vớ vẩn thế.Nếu nó nhiều quá thì làm thế nào.

Chắc bạn ấy ví dụ thôi chứ file gốc chắc nhiều lắm anh ơi

 

[snow25]

Chắc bạn ấy ví dụ thôi chứ file gốc chắc nhiều lắm anh ơi

Vậy code đây.Hi.

Sub locdulieu()
Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String, j As Integer
With Sheets("VENDOR")
     dk = .Range("E1").Value
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 11 Then Exit Sub
     arr = .Range("A11:L" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
     For i = 1 To UBound(arr, 1)
         If UCase(arr(i, 2)) = UCase(dk) Then
            a = a + 1
            For j = 1 To UBound(arr, 2)
                arr1(a, j) = arr(i, j)
            Next j
         End If
     Next i
     .Range("A4:l6").ClearContents
     If a And a < 4 Then .Range("A4").Resize(a, UBound(arr, 2)).Value = arr1 Else MsgBox "khong dung du lieu"
End With
End Sub

 

[tranphuson]

Vậy code đây.Hi.

Sub locdulieu()
Dim arr, arr1, lr As Long, i As Long, a As Long, dk As String, j As Integer
With Sheets("VENDOR")
     dk = .Range("E1").Value
     lr = .Range("B" & Rows.Count).End(xlUp).Row
     If lr < 11 Then Exit Sub
     arr = .Range("A11:L" & lr).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
     For i = 1 To UBound(arr, 1)
         If UCase(arr(i, 2)) = UCase(dk) Then
            a = a + 1
            For j = 1 To UBound(arr, 2)
                arr1(a, j) = arr(i, j)
            Next j
         End If
     Next i
     .Range("A4:l6").ClearContents
     If a And a < 4 Then .Range("A4").Resize(a, UBound(arr, 2)).Value = arr1 Else MsgBox "khong dung du lieu"
End With
End Sub

Bạn nói đúng, file này rất nhiều dòng, dữ liệu của nhà cung cấp. Mình chỉ lấy 1 phần dữ liệu nhỏ để làm ví dụ minh họa

Cảm ơn bạn đã giúp mình làm được