Copy dữ liệu từ sheet này sang sheet kia theo điều kiện

[thanhtin2378]

Nhờ mọi người giúp mình code này với, Mình có sheet "Data và sheet "CapNhat", nhờ mọi người viết code giúp mình, chạy macro thì dữ liệu ở sheet "CapNhat" copy sang sheet "Data" tương ứng theo từng mã số như file mình đính kèm.
Cảm ơn rất nhiều!

 

[Ba Tê]

Nhờ mọi người giúp mình code này với, Mình có sheet "Data và sheet "CapNhat", nhờ mọi người viết code giúp mình, chạy macro thì dữ liệu ở sheet "CapNhat" copy sang sheet "Data" tương ứng theo từng mã số như file mình đính kèm.
Cảm ơn rất nhiều!

Lấy Sub này cho cái nút bấm của bạn xem sao. Dữ liệu ít quá không cần đến Dictionary.

Option Explicit

Public Sub Gpe()
Dim ArrCN(), ArrData(), dArr(), I As Long, J As Long, K As Long, R1 As Long, R2 As Long, Maso As String
    ArrData = Sheets("Data").Range("B6", Sheets("Data").Range("B100000").End(xlUp)).Resize(, 2).Value
    R1 = UBound(ArrData)
    dArr = Sheets("Data").Range("D6").Resize(R1, 3).Value
    ArrCN = Sheets("CapNhat").Range("B7", Sheets("CapNhat").Range("B100000").End(xlUp)).Resize(, 4).Value
    R2 = UBound(ArrCN)
For I = 1 To R1
    Maso = ArrData(I, 1)
    For K = 1 To R2
        If ArrCN(K, 1) = Maso Then
            For J = 1 To 3
                dArr(I, J) = ArrCN(K, J + 1)
            Next J
            Exit For
        End If
    Next K
Next I
    Sheets("Data").Range("D6").Resize(R1, 3) = dArr
End Sub

 

[Maika8008]

Lấy Sub này cho cái nút bấm của bạn xem sao. Dữ liệu ít quá không cần đến Dictionary.

Option Explicit

Public Sub Gpe()
Dim ArrCN(), ArrData(), dArr(), I As Long, J As Long, K As Long, R1 As Long, R2 As Long, Maso As String
    ArrData = Sheets("Data").Range("B6", Sheets("Data").Range("B100000").End(xlUp)).Resize(, 2).Value
    R1 = UBound(ArrData)
    dArr = Sheets("Data").Range("D6").Resize(R1, 3).Value
    ArrCN = Sheets("CapNhat").Range("B7", Sheets("CapNhat").Range("B100000").End(xlUp)).Resize(, 4).Value
    R2 = UBound(ArrCN)
For I = 1 To R1
    Maso = ArrData(I, 1)
    For K = 1 To R2
        If ArrCN(K, 1) = Maso Then
            For J = 1 To 3
                dArr(I, J) = ArrCN(K, J + 1)
            Next J
            Exit For
        End If
    Next K
Next I
    Sheets("Data").Range("D6").Resize(R1, 3) = dArr
End Sub

Dữ liệu ít là của ví dụ chứ thực tế luôn luôn nhiều. Để xem thớt có xác nhận điều đó không?

 

[thanhtin2378]

Lấy Sub này cho cái nút bấm của bạn xem sao. Dữ liệu ít quá không cần đến Dictionary.

Option Explicit

Public Sub Gpe()
Dim ArrCN(), ArrData(), dArr(), I As Long, J As Long, K As Long, R1 As Long, R2 As Long, Maso As String
    ArrData = Sheets("Data").Range("B6", Sheets("Data").Range("B100000").End(xlUp)).Resize(, 2).Value
    R1 = UBound(ArrData)
    dArr = Sheets("Data").Range("D6").Resize(R1, 3).Value
    ArrCN = Sheets("CapNhat").Range("B7", Sheets("CapNhat").Range("B100000").End(xlUp)).Resize(, 4).Value
    R2 = UBound(ArrCN)
For I = 1 To R1
    Maso = ArrData(I, 1)
    For K = 1 To R2
        If ArrCN(K, 1) = Maso Then
            For J = 1 To 3
                dArr(I, J) = ArrCN(K, J + 1)
            Next J
            Exit For
        End If
    Next K
Next I
    Sheets("Data").Range("D6").Resize(R1, 3) = dArr
End Sub

Cảm ơn anh Ba Tê rất nhiều, chạy ngọt ngào ơi !!!!!!!!!!!

 

[Maika8008]

Nếu dòng của Data nhiều và bên CapNhat ít thì lấy mã bên CapNhat rồi dùng phương thức Find cho sheet Data để lấy row làm căn cứ điền thông tin mảng CapNhat vào mảng data có nhanh hơn không nhỉ?

 

[Maika8008]

Thớt chạy thử code này xem:

Public Sub CapNhat()
Dim ArrCN, ArrData,  i As Long,  k As Long, R As Long
    ArrData = Sheets("Data").Range("B6:F" & Sheets("Data").Range("B100000").End(xlUp).Row).Value
    ArrCN = Sheets("CapNhat").Range("B7:E" & Sheets("CapNhat").Range("B100000").End(xlUp).Row).Value
    For i = 1 To UBound(ArrCN)
        R = Sheets("Data").Range("B:B").Find(ArrCN(i, 1), Sheets("Data").Range("B1"), xlFormulas, xlWhole).Row
        For k = 2 To UBound(ArrCN, 2)
            ArrData(R - 5, k + 1) = ArrCN(i, k)
        Next
    Next
    Sheets("Data").Range("B6").Resize(UBound(ArrData), 5) = ArrData
End Sub

 

[baongocdaihocchuto]

@Maika8008
Có lẽ phải thay: R = Range("B:B").Find(ArrCN(i, 1), Range("B1"), xlFormulas, xlWhole).Row
bằng:
R = Range("B:B").Find(ArrCN(i, 1), Range("B7"), xlFormulas, xlWhole).Row

 

[Maika8008]

@Maika8008
Có lẽ phải thay: R = Range("B:B").Find(ArrCN(i, 1), Range("B1"), xlFormulas, xlWhole).Row
bằng:
R = Range("B:B").Find(ArrCN(i, 1), Range("B7"), xlFormulas, xlWhole).Row

Không phải đâu bạn, đây là tìm bên sheet Data mà, phải tìm từ B6 trở đi nên ghi B1 đến B5 đều được. Chỗ này tôi sót, lẽ ra phải là
Sheets("Data").Range("B:B").Find(ArrCN(i, 1), Range("B1"), xlFormulas, xlWhole).Row

Để tôi sửa lại bài #6

 

[HieuCD]

Không phải đâu bạn, đây là tìm bên sheet Data mà, phải tìm từ B6 trở đi nên ghi B1 đến B5 đều được. Chỗ này tôi sót, lẽ ra phải là
Sheets("Data").Range("B:B").Find(ArrCN(i, 1), Range("B1"), xlFormulas, xlWhole).Row

Để tôi sửa lại bài #6

Range("B1") của sheet nào vậy

 

[Maika8008]

Range("B1") của sheet nào vậy

Hihi. Lại ngơ ngơ nữa rồi á!

Tôi cập nhật lại bài #6. Cảm ơn bạn!