Làm sao để dùng hàm vlookup cho kết quả và nhận luôn định dạng ô chữ dữ liệu

[Vàng A Súp]

em dùng hàm vlookup để tìm số ở ô dữ liệu, nhưng 1 số ô bên đó có bôi đậm, đổ mầu ô chữ. làm sao để khi tìm ở ô kết quả nhận cả bôi đậm và mầu ô chữ như ở ô dữ liệu ạ. Mong các tiền bối giúp em với ạ. Em xin CẢM ƠN ạ

 

[Vàng A Súp]

leonguyenz
anh ơi, giúp em với ạ

 

[Hoàng Nhật Phương]

leonguyenz
anh ơi, giúp em với ạ

Trong khi chờ đơi cách làm khác bạn tham khảo cách làm bằng vba xem ổn không ạ, bạn chỉ cần nhập từ khóa trong ô A2 kết quả sẽ tự điền.
Code trong Sheet1:

Sub TimKiem(key As Variant)
    Dim rDL As Range, rKQ As Range
    Const sCol As Integer = 5
    With Me.Range("A2")
        key = .Value
        .Offset(, 1).Resize(, sCol).Clear
    End With
    Set rDL = Sheet2.Range("A3:A" & Sheet2.Range("A100000").End(xlUp).Row)
    For Each rKQ In rDL
        If rKQ.Value = key Then rKQ.Offset(, 1).Resize(, sCol).Copy Me.Range("B2")
    Next rKQ
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim key As Variant
    If Target.Address = "$A$2" Then
        If Me.Range("A2") <> Empty Then
            key = Me.Range("A2")
            TimKiem (key)
        End If
    End If
End Sub

 

[Vàng A Súp]

Trong khi chờ đơi cách làm khác bạn tham khảo cách làm bằng vba xem ổn không ạ, bạn chỉ cần nhập từ khóa trong ô A2 kết quả sẽ tự điền.
Code trong Sheet1:

Sub TimKiem(key As Variant)
    Dim rDL As Range, rKQ As Range
    Const sCol As Integer = 5
    With Me.Range("A2")
        key = .Value
        .Offset(, 1).Resize(, sCol).Clear
    End With
    Set rDL = Sheet2.Range("A3:A" & Sheet2.Range("A100000").End(xlUp).Row)
    For Each rKQ In rDL
        If rKQ.Value = key Then rKQ.Offset(, 1).Resize(, sCol).Copy Me.Range("B2")
    Next rKQ
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim key As Variant
    If Target.Address = "$A$2" Then
        If Me.Range("A2") <> Empty Then
            key = Me.Range("A2")
            TimKiem (key)
        End If
    End If
End Sub

Bác siêu nhân quá kaka, bác cho em hỏi tý nữa nhé, ví dụ em muốn tìm nhiều ô hơn như kiểu A2 A3 A4 ..... ý ạ, có VBA nào làm đc hết ko ạ, fie bên dưới là thực tế công việc em phải làm ạ, Mong bác chỉ giáo giúp em với ạ

 

[Bluestar092011]

Bác siêu nhân quá kaka, bác cho em hỏi tý nữa nhé, ví dụ em muốn tìm nhiều ô hơn như kiểu A2 A3 A4 ..... ý ạ, có VBA nào làm đc hết ko ạ

Thử thay đoạn code này vào file xem được không?

Sub TimKiem(Rng As Range)
    Dim rDL As Range, rKQ As Range, sValue As Variant
    Const sCol As Integer = 5
    sValue = Rng.Value
    Set rDL = Sheet2.Range("A3:A" & Sheet2.Range("A100000").End(xlUp).Row)
    For Each rKQ In rDL
        If rKQ.Value = sValue Then rKQ.Offset(, 1).Resize(, sCol).Copy Rng.Offset(, 1)
    Next rKQ
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sCell As Range
    For Each sCell In Target
        If Not Intersect(sCell, [A2:A14]) Is Nothing Then Call TimKiem(sCell)
    Next sCell
End Sub

 

[Vàng A Súp]

Thử thay đoạn code này vào file xem được không?

Sub TimKiem(Rng As Range)
    Dim rDL As Range, rKQ As Range, sValue As Variant
    Const sCol As Integer = 5
    sValue = Rng.Value
    Set rDL = Sheet2.Range("A3:A" & Sheet2.Range("A100000").End(xlUp).Row)
    For Each rKQ In rDL
        If rKQ.Value = sValue Then rKQ.Offset(, 1).Resize(, sCol).Copy Rng.Offset(, 1)
    Next rKQ
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sCell As Range
    For Each sCell In Target
        If Not Intersect(sCell, [A2:A14]) Is Nothing Then Call TimKiem(sCell)
    Next sCell
End Sub

hehe, chuẩn luôn bác ạ, em cám ơn bác nhé

Bài đã được tự động gộp: 12/4/20

Thử thay đoạn code này vào file xem được không?

Sub TimKiem(Rng As Range)
    Dim rDL As Range, rKQ As Range, sValue As Variant
    Const sCol As Integer = 5
    sValue = Rng.Value
    Set rDL = Sheet2.Range("A3:A" & Sheet2.Range("A100000").End(xlUp).Row)
    For Each rKQ In rDL
        If rKQ.Value = sValue Then rKQ.Offset(, 1).Resize(, sCol).Copy Rng.Offset(, 1)
    Next rKQ
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sCell As Range
    For Each sCell In Target
        If Not Intersect(sCell, [A2:A14]) Is Nothing Then Call TimKiem(sCell)
    Next sCell
End Sub

Bác ơi, bác làm ơn thì làm ơn cho chót, em dốt VBA lắm, huhu, em còn 1 cái phụ biểu như này nữa, bác siêu nhân giúp em với đc ko ạ, Em xin chân thành cám ơn bác nhiều nhiều nhiều

 

[Bluestar092011]

hehe, chuẩn luôn bác ạ, em cám ơn bác nhé

Bài đã được tự động gộp: 12/4/20

Bác ơi, bác làm ơn thì làm ơn cho chót, em dốt VBA lắm, huhu, em còn 1 cái phụ biểu như này nữa, bác siêu nhân giúp em với đc ko ạ, Em xin chân thành cám ơn bác nhiều nhiều nhiều

Xin lỗi tôi không phải siêu nhân. Muốn giúp gì thì mô tả cho tôi hiểu chứ tôi không biết mò.

 

[Vàng A Súp]

Xin lỗi tôi không phải siêu nhân. Muốn giúp gì thì mô tả cho tôi hiểu chứ tôi không biết mò.

Gớm, nịnh bác tý mà làm gì căng. ý em là khi em đánh số 1 ở bên bảng khối lượng thi công thì các số trong bảng sẽ lấy từ bên phụ lục,
em có 11 cái hợp đồng, 1 hợp đồng của em có tới 22 dòng lận. như cái bên trên em nhờ các bác thì có mỗi dòng thui
và em lại muốn khi tìm ra kết quả vẫn nhận cả bôi đậm với mầu ô như bên phụ lục.

 

[Vàng A Súp]

Xin lỗi tôi không phải siêu nhân. Muốn giúp gì thì mô tả cho tôi hiểu chứ tôi không biết mò.

Bác nghiên cứu giúp em với ạ, huhu. Mùa covit người ta ở nhà ngủ, em vẫn phải lọ mọ nhục quá bác ạ

 

[giaiphap]

Bác nghiên cứu giúp em với ạ, huhu. Mùa covit người ta ở nhà ngủ, em vẫn phải lọ mọ nhục quá bác ạ

Bạn sửa lại code thế này xem (Mượn code #5).

Sub TimKiem(Rng As Range)
    Dim rDL As Range, rKQ As Range, sValue As Variant
    Const sCol As Integer = 11
    sValue = Rng.Value
    Set rDL = Sheet9.Range("A5:A" & Sheet9.Range("A100000").End(xlUp).Row)
    For Each rKQ In rDL
        If rKQ.Value = sValue Then 
             rKQ.Offset(, 1).Resize(22, sCol).Copy Sheet2.Range("A10")
             Exit Sub
        End If
    Next rKQ
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sCell As Range
    If Target.Address(0, 0) = "R10" Then
        Application.EnableEvents = False
            With Sheet2
                .Range("A10:K12").ClearContents
                Call TimKiem(Target)
            End With
        Application.EnableEvents = True
    End If
End Sub