Tìm vùng dữ liệu bằng VBA

Vũ Đại Hiệp

Thành viên mới
Em xin chào các bác, các anh / chị
File Excel của em có 14 hợp đồng.
Tại Sheet " Bảng kê " em muốn dò tìm 1 vùng dữ liệu hiện thị tại ô A10 : Q 33 với giá trị dò tìm ở ô C37 ( C37 là số hợp đồng, được tăng lên giảm xuống qua nút ấn ), và vùng dò tìm ở Sheet " Phụ lục".
Em mong nhận được sự giúp đỡ của các bác, anh chị trong diễn đàn. Chúc mọi người một buổi chiều vui vẻ ạ
 

Binana

Thành viên
Em xin chào các bác, các anh / chị
File Excel của em có 14 hợp đồng.
Tại Sheet " Bảng kê " em muốn dò tìm 1 vùng dữ liệu hiện thị tại ô A10 : Q 33 với giá trị dò tìm ở ô C37 ( C37 là số hợp đồng, được tăng lên giảm xuống qua nút ấn ), và vùng dò tìm ở Sheet " Phụ lục".
Em mong nhận được sự giúp đỡ của các bác, anh chị trong diễn đàn. Chúc mọi người một buổi chiều vui vẻ ạ
Mã:
Sub ABC()
Dim iR&, DK&, X&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    iR = Sheets("Phu Luc").Range("C" & Rows.Count).End(3).Row
    DK = Sheets("Bang Ke").Range("C37").Value
    Sheets("Bang Ke").Range("A10:Q33").ClearContents
    For X = 7 To iR Step 25
        If Sheets("Phu Luc").Range("A" & X).Value = DK Then
            Sheets("Phu Luc").Range("B" & X).Resize(24, 17).Copy
            Sheets("Bang Ke").Range("A10").PasteSpecial Paste:=xlPasteValues
            Exit For
            Application.CutCopyMode = False
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Ban thử code này và thay đổi tên sheet thành Phu Luc và Bang Ke viết không dấu nhé
 

Vũ Đại Hiệp

Thành viên mới
Mã:
Sub ABC()
Dim iR&, DK&, X&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    iR = Sheets("Phu Luc").Range("C" & Rows.Count).End(3).Row
    DK = Sheets("Bang Ke").Range("C37").Value
    Sheets("Bang Ke").Range("A10:Q33").ClearContents
    For X = 7 To iR Step 25
        If Sheets("Phu Luc").Range("A" & X).Value = DK Then
            Sheets("Phu Luc").Range("B" & X).Resize(24, 17).Copy
            Sheets("Bang Ke").Range("A10").PasteSpecial Paste:=xlPasteValues
            Exit For
            Application.CutCopyMode = False
        End If
    Next
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Ban thử code này và thay đổi tên sheet thành Phu Luc và Bang Ke viết không dấu nhé
Em cám ơn bác nhiều nhé, hì hì. Mấy ngày nghỉ phép không có máy tính không vào được lên không cám ơn bác kịp thời được. Chúc bác nghỉ lễ vui vẻ bên gia đình ạ
 
Top