Giúp dùm mình viết code thay thế hàm vlookup và code update (3 người xem)

[phucuongn]

Chào các anh chị trên diễn đàn ! mình có một vấn đề nhờ các anh chị giúp mình
Mình có một file gồm 3 sheet (data, chitiet,tonghop)
mình muốn khi nhập dữ liệu ở sheet chitiet thì sheet này dò tìm ở sheet data để lấy dữ liệu qua
sau đó mình nhấn nút send thì các dữ liệu ở sheet chitiet sẽ gửi qua sheet tonghop để lưu lại hàng ngày
đồng thời xóa dữ liệu ở sheet chitiet
Nhờ các anh chị giúp mình viết code thay thế hàm vlookup và code update khi nhấn nút send
cám ơn các anh chị rất nhiều

 

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

Bạn tìm trong Sub dòng này:

sArr = .Range("C5", .Range("C5").End(xlDown)).Resize(, 7).Value '7 = So cot cua Data'

Thay bằng cái này:

sArr = .Range("C5", .Range("C1048576").End(xlUp)).Resize(, 7).Value    '7 = So cot cua Data'

Hi, bạn trả lời nhanh thật
Oanh Thơ vừa sửa lại bài viết trên (_ _)

 

[Ba Tê]

Hi, bạn trả lời nhanh thật
Oanh Thơ vừa sửa lại bài viết trên (_ _)

Lúc muốn xóa dòng, lúc muốn chèn cột ... thì nếu đọc hiểu code chỉ cần chỉnh 1 chút thôi.
Rút kinh nghiệm, nếu bạn không thật hiểu code thì khi đưa dữ liệu phải giống như thật để người giúp làm 1 lần là đủ.
Nếu kết quả sai thì dẫn chứng chỗ sai.

Public Sub GPE()
Dim sArr(), dArr(), tArr(), Lubu(), I As Long, J As Long, R As Long, Col As Long, Rws As Long
With Sheets("Data")
    sArr = .Range("C5", .Range("C1048576").End(xlUp)).Resize(, .Range("C4").End(xlToRight).Column - 2).Value
End With
R = UBound(sArr)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        .Add sArr(I, 1), I
    Next I
    With Sheets("Sheet1")
        tArr = .Range("C5", .Range("C5").End(xlDown)).Value
        R = UBound(tArr)
        Col = .Range("E4", .Range("E4").End(xlToRight)).Columns.Count
        Lubu = .Range("E4").Resize(, Col).Value
        ReDim dArr(1 To R, 1 To Col)
    End With
    For I = 1 To R
        If .Exists(tArr(I, 1)) Then
            Rws = .Item(tArr(I, 1))
            For J = 1 To Col
                dArr(I, J) = sArr(Rws, Lubu(1, J))
            Next J
        End If
    Next I
End With
Sheets("Sheet1").Range("E5").Resize(R, Col) = dArr
End Sub

 

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

Lúc muốn xóa dòng, lúc muốn chèn cột ... thì nếu đọc hiểu code chỉ cần chỉnh 1 chút thôi.
Rút kinh nghiệm, nếu bạn không thật hiểu code thì khi đưa dữ liệu phải giống như thật để người giúp làm 1 lần là đủ.
Nếu kết quả sai thì dẫn chứng chỗ sai.

Public Sub GPE()
Dim sArr(), dArr(), tArr(), Lubu(), I As Long, J As Long, R As Long, Col As Long, Rws As Long
With Sheets("Data")
    sArr = .Range("C5", .Range("C1048576").End(xlUp)).Resize(, .Range("C4").End(xlToRight).Column - 2).Value
End With
R = UBound(sArr)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        .Add sArr(I, 1), I
    Next I
    With Sheets("Sheet1")
        tArr = .Range("C5", .Range("C5").End(xlDown)).Value
        R = UBound(tArr)
        Col = .Range("E4", .Range("E4").End(xlToRight)).Columns.Count
        Lubu = .Range("E4").Resize(, Col).Value
        ReDim dArr(1 To R, 1 To Col)
    End With
    For I = 1 To R
        If .Exists(tArr(I, 1)) Then
            Rws = .Item(tArr(I, 1))
            For J = 1 To Col
                dArr(I, J) = sArr(Rws, Lubu(1, J))
            Next J
        End If
    Next I
End With
Sheets("Sheet1").Range("E5").Resize(R, Col) = dArr
End Sub

Cảm ơn ban Ba Tê vui tính và tốt bụng nhiều nhiều.
Oanh Thơ cũng đã gửi file mẫu giống với file thực. Nhưng quá trình sử dụng có thể xảy ra các tình huống mà Oanh Thơ đã hỏi thêm. Oanh Thơ chưa thể lường hết được các tình huống đó.
Xin lỗi bạn nhé.

Bạn có thể coment thêm vào mỗi dòng code để Oanh Thơ có thể hiểu và tự tùy biến được khi có sự thay đổi được không ạ.

 

[củ lạc]

Code trên của bạn Ba Tê , trong sheet Data nếu số dòng không có dữ liệu liền nhau >=2 thì sẽ lỗi,xong lại hỏi

 

[say you will]

Tôi tải file kèm ở bài 42 về áp dụng với dữ liệu tại cột C là a,b,c thì không sử dụng được.
Nhờ Anh/Chị giúp đỡ.

Cảm ơn

 

[Ba Tê]

Tôi tải file kèm ở bài 42 về áp dụng với dữ liệu tại cột C là a,b,c thì không sử dụng được.
Nhờ Anh/Chị giúp đỡ.

Cảm ơn

Bạn đưa file mà bạn thay cột C là a,b,c lên xem nó lỗi chỗ nào mà không sử dụng được.

 

[say you will]

Vâng, nhờ Anh/Chị xem giúp cho

https://secufiles.com/d6RL/GPE_Vlookup2.xlsm

cảm ơn

 

[Ba Tê]

Vâng, nhờ Anh/Chị xem giúp cho

https://secufiles.com/d6RL/GPE_Vlookup2.xlsm

cảm ơn

Lý do dữ liệu cột C sheet Data bị trùng.
Bạn tìm trong Sub dòng này:

For I = 1 To R
        .Add sArr(I, 1), I
Next I

Sửa lại thành như vầy:

For I = 1 To R
        If sArr(I, 1) <> Empty And Not .Exists(sArr(I, 1)) Then .Add sArr(I, 1), I
Next I

 

[say you will]

Dòng đó để trong sheet nào vùng nào vậy Anh/Chị ơi, tôi tìm mãi không thấy.

 

[Ba Tê]

Dòng đó để trong sheet nào vùng nào vậy Anh/Chị ơi, tôi tìm mãi không thấy.

Híc!
Bạn ấn Alt+F11 sẽ thấy nó trong Module1.

 

[say you will]

@@! Sao nhìn loằng ngoằng vậy Anh/Chị?
Thôi tôi dùng công thức,híc.

Cảm ơn Anh/Chị.