Code cập nhật dữ liệu từ sheet1 sang sheet2 theo điều kiện (1 người xem)

[tanthanh94]

mình muốn cập nhật dữ liệu từ sheet1 sang sheet2 theo điệu kiện như sau
chỉ cập nhật thêm những code mới sang cột A sheet 2 (không cập nhật những code đã có)
và cho số lượng vào cột F của sheet2
Các anh xem file đính kèm.

 

[hung2412]

mình muốn cập nhật dữ liệu từ sheet1 sang sheet2 theo điệu kiện như sau
chỉ cập nhật thêm những code mới sang cột A sheet 2 (không cập nhật những code đã có)
và cho số lượng vào cột F của sheet2
Các anh xem file đính kèm.

Code cùi:
[GPECODE=vb]Sub Update()
Dim Dic As Object
Dim i As Long
Dim Tam
Set Dic = CreateObject("Scripting.Dictionary")
For i = 5 To Sheets(2).[A65536].End(xlUp).Row
Tam = Sheets(2).Cells(i, 1).Value
If Not Dic.exists(Tam) Then
Dic.Add Tam, i
End If
Next
For i = 4 To Sheets(1).[A65536].End(xlUp).Row
Tam = Sheets(1).Cells(i, 1).Value
If Dic.exists(Tam) Then
Sheets(1).Cells(i, 2).Copy Sheets(2).Cells(Dic.Item(Tam), 6)
Else
Sheets(1).Cells(i, 1).Copy Sheets(2).[A65536].End(xlUp).Offset(1, 0)
Sheets(1).Cells(i, 2).Copy Sheets(2).[A65536].End(xlUp).Offset(, 5)
End If
Next
End Sub[/GPECODE]

 

[Let'GâuGâu]

mình muốn cập nhật dữ liệu từ sheet1 sang sheet2 theo điệu kiện như sau
chỉ cập nhật thêm những code mới sang cột A sheet 2 (không cập nhật những code đã có)
và cho số lượng vào cột F của sheet2
Các anh xem file đính kèm.

ké một đoạn code

Sub tonghop()
Dim sM, sH As Variant, kq(), i, j, k, tong As Long, d As Object
sM = Sheet1.[a4].Resize(Sheet1.[a1000].End(3).Row - 3, 2).Value
sH = Sheet2.[a5].Resize(Sheet2.[a1000].End(3).Row - 4, 5).Value
Set d = CreateObject("Scripting.Dictionary")
ReDim kq(1 To UBound(sM) + UBound(sH), 1 To 6)
For i = 1 To UBound(sH)
    If Not d.exists(sH(i, 1)) Then
        k = k + 1
        d.Add sH(i, 1), k
        For j = 1 To 5
            kq(k, j) = sH(i, j)
        Next
    End If
Next
For i = 1 To UBound(sM)
    If Not d.exists(sM(i, 1)) Then
        k = k + 1
        d.Add sM(i, 1), k
        kq(k, 1) = sM(i, 1)
        kq(k, 6) = sM(i, 2)
    Else
        kq(d.Item(sM(i, 1)), 6) = sM(i, 2)
    End If
Next

[j5:o10000].ClearContents
[j5].Resize(k, 6).Value = kq
Set d = Nothing

End Sub

 

[tanthanh94]

ké một đoạn code

Sub tonghop()
Dim sM, sH As Variant, kq(), i, j, k, tong As Long, d As Object
sM = Sheet1.[a4].Resize(Sheet1.[a1000].End(3).Row - 3, 2).Value
sH = Sheet2.[a5].Resize(Sheet2.[a1000].End(3).Row - 4, 5).Value
Set d = CreateObject("Scripting.Dictionary")
ReDim kq(1 To UBound(sM) + UBound(sH), 1 To 6)
For i = 1 To UBound(sH)
    If Not d.exists(sH(i, 1)) Then
        k = k + 1
        d.Add sH(i, 1), k
        For j = 1 To 5
            kq(k, j) = sH(i, j)
        Next
    End If
Next
For i = 1 To UBound(sM)
    If Not d.exists(sM(i, 1)) Then
        k = k + 1
        d.Add sM(i, 1), k
        kq(k, 1) = sM(i, 1)
        kq(k, 6) = sM(i, 2)
    Else
        kq(d.Item(sM(i, 1)), 6) = sM(i, 2)
    End If
Next

[j5:o10000].ClearContents
[j5].Resize(k, 6).Value = kq
Set d = Nothing

End Sub

Em thử test code

sM = Sheet1.[a4].Resize(Sheet1.[a1000].End(3).Row - 3, 2).Value
sH = Sheet2.[a5].Resize(Sheet2.[a1000].End(3).Row - 4, 5).Value

thành đoạn code sau

With Sheet1
sM = Range("A4", [A65000].End(3)).Resize(, 2).Value
End With
With Sheet2
sH = Range("A5", [A65000].End(3)).Resize(, 5).Value
End With

Nhưng kết quả không như ý muốn
Không biết sai chỗ nào,anh chỉ giúp
Rất cám ơn bài viết của anh.

 

[comet_1701]

mình muốn cập nhật dữ liệu từ sheet1 sang sheet2 theo điệu kiện như sau
chỉ cập nhật thêm những code mới sang cột A sheet 2 (không cập nhật những code đã có)
và cho số lượng vào cột F của sheet2
Các anh xem file đính kèm.

Sub Ghep()
Dim Rng As Range, Rng1 As Range, i As Long, cll As Range, Kq As Range
Set Rng = Sheet1.Range("A4", Sheet1.[A65000].End(xlUp))
Set Rng1 = Sheet2.Range("A5", Sheet2.[A65000].End(xlUp))
For Each cll In Rng
    If Application.IsNA(Application.Match(cll, Rng1, 0)) Then
        Sheet2.[A65000].End(xlUp).Offset(1, 0) = cll
    End If
Next
For i = 5 To Rng.Rows.Count * 4
    Set Kq = Sheet1.[A:A].Find(Sheet2.Cells(i, 1), , , xlWhole)
    If Not Kq Is Nothing Then
        Cells(i, 6) = Kq.Offset(, 1)
    End If
Next
Set Rng = Nothing
Set Rng1 = Nothing
Set Kq = Nothing
End Sub

Thử ko dùng dic xem sao

 

[comet_1701]

Em thử test code

sM = Sheet1.[a4].Resize(Sheet1.[a1000].End(3).Row - 3, 2).Value
sH = Sheet2.[a5].Resize(Sheet2.[a1000].End(3).Row - 4, 5).Value

thành đoạn code sau

With Sheet1
sM = Range("A4", [A65000].End(3)).Resize(, 2).Value
End With
With Sheet2
sH = Range("A5", [A65000].End(3)).Resize(, 5).Value
End With

Nhưng kết quả không như ý muốn
Không biết sai chỗ nào,anh chỉ giúp
Rất cám ơn bài viết của anh.

With Sheet1
sM = .Range("A4", .[A65000].End(3)).Resize(, 2).Value
End With

Bạn sửa thế này xem sao

 

[tanthanh94]

With Sheet1
sM = .Range("A4", .[A65000].End(3)).Resize(, 2).Value
End With

Bạn sửa thế này xem sao

như vậy chạy được
Cám ơn Anh nha

 

[Ba Tê]

Em thử test code

sM = Sheet1.[a4].Resize(Sheet1.[a1000].End(3).Row - 3, 2).Value
sH = Sheet2.[a5].Resize(Sheet2.[a1000].End(3).Row - 4, 5).Value

thành đoạn code sau

With Sheet1
sM = Range("A4", [A65000].End(3)).Resize(, 2).Value
End With
With Sheet2
sH = Range("A5", [A65000].End(3)).Resize(, 5).Value
End With

Nhưng kết quả không như ý muốn
Không biết sai chỗ nào,anh chỉ giúp
Rất cám ơn bài viết của anh.

Xem thử File này.
Ở sheet2 sẽ ghi dữ liệu vào cột cuối cùng có tiêu đề trên dòng 4 chứ không cố định là cột F

 

[tanthanh94]

Xem thử File này.
Ở sheet2 sẽ ghi dữ liệu vào cột cuối cùng có tiêu đề trên dòng 4 chứ không cố định là cột F

Qúa hay luôn anh ơi
Cám ơn anh rất nhiều