Giúp code cập nhật dữ liệu theo ID

[hondacrv2019]

Chào toàn thể diễn đàn.
Em có 1 bảng tính mổi lần thay đổi dữ liệu em phải sữa bằng tay rất lâu, Mấy bác có cách nào viết code để em bấm 1 cái là nó tự động sửa theo bảng sửa đổi em đã cài sẳng
File gồm 2 vùng :
Bảng 1: là bảng ghi dữ liệu hàng ngày của công ty. Do mổi lần công ty thay đổi số liệu thì em phải dò bằng tay rồi sữa tại Bảng 1, làm rất là lâu
Bảng 2: Em tự thiết kế sẳng bảng 2 để thay đổi dử liệu trước sau đó bấm nút bấm là nó tự cập nhật sang bảng 1.

Như ảnh bên dưới em chỉ muốn cập nhật số liệu( tên hàng,chiều cao, cân nặng, Giá ) lại các dòng màu đỏ theo số ID trong bảng 2. Nên em không thể dùng Vlookup được
Em xin chân thành cảm ơn!

 

[snow25]

Chào toàn thể diễn đàn.
Em có 1 bảng tính mổi lần thay đổi dữ liệu em phải sữa bằng tay rất lâu, Mấy bác có cách nào viết code để em bấm 1 cái là nó tự động sửa theo bảng sửa đổi em đã cài sẳng
File gồm 2 vùng :
Bảng 1: là bảng ghi dữ liệu hàng ngày của công ty. Do mổi lần công ty thay đổi số liệu thì em phải dò bằng tay rồi sữa tại Bảng 1, làm rất là lâu
Bảng 2: Em tự thiết kế sẳng bảng 2 để thay đổi dử liệu trước sau đó bấm nút bấm là nó tự cập nhật sang bảng 1.

Như ảnh bên dưới em chỉ muốn cập nhật số liệu( tên hàng,chiều cao, cân nặng, Giá ) lại các dòng màu đỏ theo số ID trong bảng 2. Nên em không thể dùng Vlookup được
Em xin chân thành cảm ơn!

View attachment 218567

Bạn thử.

Sub linhtinh()
    Dim arr, darr, i As Long, lr As Long, dic As Object, dk As String, a As Long, j As Integer
    Set dic = CreateObject("scripting.dictionary")
    With Sheet1
        lr = .Range("i" & Rows.Count).End(xlUp).Row
        If lr < 5 Then Exit Sub
        arr = .Range("i5:M" & lr).Value
        For i = 1 To UBound(arr, 1)
            dk = arr(i, 1)
            dic.Item(dk) = i
        Next i
        lr = .Range("b" & Rows.Count).End(xlUp).Row
        darr = .Range("b5:F" & lr).Value
           For i = 1 To UBound(darr)
               dk = darr(i, 1)
               If dic.exists(dk) Then
                  a = dic.Item(dk)
                  For j = 2 To UBound(darr, 2)
                      darr(i, j) = arr(a, j)
                  Next j
               End If
           Next i
        .Range("b5:F" & lr).Value = darr
    End With
End Sub

 

[leonguyenz]

Chào toàn thể diễn đàn.
Em có 1 bảng tính mổi lần thay đổi dữ liệu em phải sữa bằng tay rất lâu, Mấy bác có cách nào viết code để em bấm 1 cái là nó tự động sửa theo bảng sửa đổi em đã cài sẳng
File gồm 2 vùng :
Bảng 1: là bảng ghi dữ liệu hàng ngày của công ty. Do mổi lần công ty thay đổi số liệu thì em phải dò bằng tay rồi sữa tại Bảng 1, làm rất là lâu
Bảng 2: Em tự thiết kế sẳng bảng 2 để thay đổi dử liệu trước sau đó bấm nút bấm là nó tự cập nhật sang bảng 1.

Như ảnh bên dưới em chỉ muốn cập nhật số liệu( tên hàng,chiều cao, cân nặng, Giá ) lại các dòng màu đỏ theo số ID trong bảng 2. Nên em không thể dùng Vlookup được
Em xin chân thành cảm ơn!

View attachment 218567

Nếu bạn cho sẵn trước ID ở cột I, sao không dùng hàm VLOOKUP lấy dữ liệu qua mà phải dùng code?

 

[hondacrv2019]

Nếu bạn cho sẵn trước ID ở cột I, sao không dùng hàm VLOOKUP lấy dữ liệu qua mà phải dùng code?

Bảng 2 là bảng do e tự nhập bằng tay anh. Em muốn nó cập nhật từ bảng 2 sang bảng 1 anh nhe ( chứ không phải từ 1 sang 2 )

 

[leonguyenz]

Bảng 2 là bảng do e tự nhập bằng tay anh. Em muốn nó cập nhật từ bảng 2 sang bảng 1 anh nhe ( chứ không phải từ 1 sang 2 )

Code bài #2.
Tham khảo thêm cách dùng phương thức Find

Sub GpeFind()
Dim Rng As Range, iRng As Range, fRng As Range, i As Long, j As Integer
Set Rng = Sheet1.Range("I5:M" & Sheet1.Range("I65535").End(xlUp).Row)
Set iRng = Sheet1.Range("B5:B" & Sheet1.Range("B65535").End(xlUp).Row)
For i = 1 To Rng.Rows.Count
    Set fRng = iRng.Find(Rng(i, 1), , , 1)
    If Not fRng Is Nothing Then
        For j = 1 To Rng.Columns.Count - 1
            fRng.Offset(, j) = Rng(i, j + 1)
        Next j
    End If
Next i
End Sub

 

[Hai Lúa Miền Tây]

Chào toàn thể diễn đàn.
Em có 1 bảng tính mổi lần thay đổi dữ liệu em phải sữa bằng tay rất lâu, Mấy bác có cách nào viết code để em bấm 1 cái là nó tự động sửa theo bảng sửa đổi em đã cài sẳng
File gồm 2 vùng :
Bảng 1: là bảng ghi dữ liệu hàng ngày của công ty. Do mổi lần công ty thay đổi số liệu thì em phải dò bằng tay rồi sữa tại Bảng 1, làm rất là lâu
Bảng 2: Em tự thiết kế sẳng bảng 2 để thay đổi dử liệu trước sau đó bấm nút bấm là nó tự cập nhật sang bảng 1.

Như ảnh bên dưới em chỉ muốn cập nhật số liệu( tên hàng,chiều cao, cân nặng, Giá ) lại các dòng màu đỏ theo số ID trong bảng 2. Nên em không thể dùng Vlookup được
Em xin chân thành cảm ơn!

View attachment 218567

Dùng ADO code sẽ gọn hơn nhé

Sub CapNhat_HLMT()
    With CreateObject("ADODB.Connection")
        .Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended properties=""Excel 12.0;HDR=No""")
        .Execute ("Update [Sheet1$B5:F30] a " & _
                         "inner join [Sheet1$I5:M8] b " & _
                         "on a.[F1]=b.[F1] " & _
                  "set a.[F2]=b.[F2],a.[F3]=b.[F3],a.[F4]=b.[F4],a.[F5]=b.[F5] ")
    End With
End Sub

 

[leonguyenz]

Dùng ADO code sẽ gọn hơn nhé

Sub CapNhat_HLMT()
    With CreateObject("ADODB.Connection")
        .Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended properties=""Excel 12.0;HDR=No""")
        .Execute ("Update [Sheet1$B5:F30] a " & _
                         "inner join [Sheet1$I5:M8] b " & _
                         "on a.[F1]=b.[F1] " & _
                  "set a.[F2]=b.[F2],a.[F3]=b.[F3],a.[F4]=b.[F4],a.[F5]=b.[F5] ")
    End With
End Sub

ADO nó hay, mà phải đồng nhất dữ liệu, set thêm version nữa, nên chỉ dùng khi biết cách vận hành nó thôi.

 

[SA_DQ]

ADO nó hay, mà phải đồng nhất dữ liệu, set thêm version nữa, nên chỉ dùng khi biết cách vận hành nó thôi.

Nói nôm na là cần có vốn đối ứng cao hơn VBA, vậy đi!

 

[snow25]

Dùng ADO code sẽ gọn hơn nhé

Sub CapNhat_HLMT()
    With CreateObject("ADODB.Connection")
        .Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended properties=""Excel 12.0;HDR=No""")
        .Execute ("Update [Sheet1$B5:F30] a " & _
                         "inner join [Sheet1$I5:M8] b " & _
                         "on a.[F1]=b.[F1] " & _
                  "set a.[F2]=b.[F2],a.[F3]=b.[F3],a.[F4]=b.[F4],a.[F5]=b.[F5] ")
    End With
End Sub

2 chỉ số a với b ở đây là gì vậy anh.Mình tự đặt cho nó à.

 

[Hai Lúa Miền Tây]

2 chỉ số a với b ở đây là gì vậy anh.Mình tự đặt cho nó à.

Đúng vậy bạn. Đặt để tham chiếu cho gọn a = [Sheet1$B5:F30] và b = [Sheet1$I5:M8]

 

[snow25]

Đúng vậy bạn. Đặt để tham chiếu cho gọn a = [Sheet1$B5:F30] và b = [Sheet1$I5:M8]

Vâng cảm ơn anh ạ.

 

[hondacrv2019]

Bạn thử.

Sub linhtinh()
    Dim arr, darr, i As Long, lr As Long, dic As Object, dk As String, a As Long, j As Integer
    Set dic = CreateObject("scripting.dictionary")
    With Sheet1
        lr = .Range("i" & Rows.Count).End(xlUp).Row
        If lr < 5 Then Exit Sub
        arr = .Range("i5:M" & lr).Value
        For i = 1 To UBound(arr, 1)
            dk = arr(i, 1)
            dic.Item(dk) = i
        Next i
        lr = .Range("b" & Rows.Count).End(xlUp).Row
        darr = .Range("b5:F" & lr).Value
           For i = 1 To UBound(darr)
               dk = darr(i, 1)
               If dic.exists(dk) Then
                  a = dic.Item(dk)
                  For j = 2 To UBound(darr, 2)
                      darr(i, j) = arr(a, j)
                  Next j
               End If
           Next i
        .Range("b5:F" & lr).Value = darr
    End With
End Sub

Code của bác hơi bị Víp đấy. Cảm ơn bác nhiều

 

[quanluu]

2 chỉ số a với b ở đây là gì vậy anh.Mình tự đặt cho nó à.

a, b ở đây được gọi là alias hay là bí danh, giống như tên gọi ở nhà của bạn (tí, tèo..) cho gọn và dễ nhớ, mình cũng hay dùng là a, b nhưng người khác có thể đặt tên sao cho dễ nhớ hơn, đặc biệt là khi code dài.