VBA code cập nhật theo điều kiện loại trùng

MeThuongNho · 5/11/21

KÍnh gửi Anh/Chị,
Em có Code Capnhat ở link bài cũ: Link bài cũ
Code nay đã hoàn thiện được 01 phần mong muốn rồi nhưng chưa thỏa yêu cầu.
- Khi chạy code Capnhat lần 1: thì nó copy theo code đã đúng.
- Khi chạy lần 2 trở đi: ( lúc nay dữ liệu bên sheet DS-TH đã có sự thay đổi dòng(row) thứ tự mã NV: do Insert thêm nhân viên mới vào vùng(range) cùng bộ phận để dễ theo dõi).
Em muốn là: chỉ copy các dòng đã insert đó -- thêm qua dòng cuối của sheet DS TONG
(không phải cập nhật lại danh sách: tức là những mã NV đã copy rồi không copy nữa: Code dò trùng thì không lấy nữa, cái nào phát sinh thì dán tiếp vào dòng cuối ạ).
Em có đính kèm file.
Mong mọi người giúp đỡ ạ.
Trân trọng!

snow25 · 5/11/21

MeThuongNho đã viết:
KÍnh gửi Anh/Chị,
Em có Code Capnhat ở link bài cũ: Link bài cũ
Code nay đã hoàn thiện được 01 phần mong muốn rồi nhưng chưa thỏa yêu cầu.
- Khi chạy code Capnhat lần 1: thì nó copy theo code đã đúng.
- Khi chạy lần 2 trở đi: ( lúc nay dữ liệu bên sheet DS-TH đã có sự thay đổi dòng(row) thứ tự mã NV: do Insert thêm nhân viên mới vào vùng(range) cùng bộ phận để dễ theo dõi).
Em muốn là: chỉ copy các dòng đã insert đó -- thêm qua dòng cuối của sheet DS TONG
(không phải cập nhật lại danh sách: tức là những mã NV đã copy rồi không copy nữa: Code dò trùng thì không lấy nữa, cái nào phát sinh thì dán tiếp vào dòng cuối ạ).
Em có đính kèm file.
Mong mọi người giúp đỡ ạ.
Trân trọng!

Nghiên cứu thêm Dictionary.

MeThuongNho · 8/11/21

snow25 đã viết:
Nghiên cứu thêm Dictionary.

Dạ, em không rành VBA, mong Anh/Chị chỉ thêm ạ.
Dictionary của nhiều cột thì làm sao ạ, Em có được code Caphnhat chỉ lấy 1 cột à.
File đính kèm.
Trân trọng!

HieuCD · 8/11/21

MeThuongNho đã viết:
KÍnh gửi Anh/Chị,
Em có Code Capnhat ở link bài cũ: Link bài cũ
Code nay đã hoàn thiện được 01 phần mong muốn rồi nhưng chưa thỏa yêu cầu.
- Khi chạy code Capnhat lần 1: thì nó copy theo code đã đúng.
- Khi chạy lần 2 trở đi: ( lúc nay dữ liệu bên sheet DS-TH đã có sự thay đổi dòng(row) thứ tự mã NV: do Insert thêm nhân viên mới vào vùng(range) cùng bộ phận để dễ theo dõi).
Em muốn là: chỉ copy các dòng đã insert đó -- thêm qua dòng cuối của sheet DS TONG
(không phải cập nhật lại danh sách: tức là những mã NV đã copy rồi không copy nữa: Code dò trùng thì không lấy nữa, cái nào phát sinh thì dán tiếp vào dòng cuối ạ).
Em có đính kèm file.
Mong mọi người giúp đỡ ạ.
Trân trọng!

Chạy code mới

Mã:

Option Explicit
Sub XYZ()
  Dim sArr(), res(), dic As Object, iKey$
  Dim eRow&, sRow&, i&, k&
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("DS TONG") 'Du lieu cu
    eRow = .Range("E" & Rows.Count).End(xlUp).Row
    If eRow > 5 Then
      sArr = .Range("E5:E" & eRow).Value
      sRow = UBound(sArr)
      For i = 1 To sRow
        dic.Item(CStr(sArr(i, 1))) = ""
      Next i
    End If
  End With
  With Sheets("DS-TH") 'Tim du lieu moi
    i = .Range("E" & Rows.Count).End(xlUp).Row
    If i < 4 Then MsgBox ("Khong co du lieu, thoat chuong trinh"): Exit Sub
    sArr = .Range("D4:L" & i).Value
  End With
  sRow = UBound(sArr)
  ReDim res(1 To UBound(sArr), 1 To 5)
  For i = 1 To sRow
    iKey = CStr(sArr(i, 2))
    If iKey <> Empty Then
      If dic.exists(iKey) = False Then
        k = k + 1
        res(k, 1) = sArr(i, 9)
        res(k, 2) = sArr(i, 2)
        res(k, 3) = sArr(i, 3)
        res(k, 4) = sArr(i, 1)
        res(k, 5) = sArr(i, 4)
        dic.Add iKey, ""
      End If
    End If
  Next i
  If k > 0 Then
    Sheets("DS TONG").Range("D" & eRow + 1).Resize(k, 5) = res
    MsgBox "Da Cap Nhat Them :   " & k & " Nhan Vien"
  Else
    MsgBox "Khong co Nhan Vien Moi!"
  End If
End Sub

MeThuongNho · 8/11/21

HieuCD đã viết:

Chạy code mới

Mã:

Option Explicit
Sub XYZ()
  Dim sArr(), res(), dic As Object, iKey$
  Dim eRow&, sRow&, i&, k&
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("DS TONG") 'Du lieu cu
    eRow = .Range("E" & Rows.Count).End(xlUp).Row
    If eRow > 5 Then
      sArr = .Range("E5:E" & eRow).Value
      sRow = UBound(sArr)
      For i = 1 To sRow
        dic.Item(CStr(sArr(i, 1))) = ""
      Next i
    End If
  End With
  With Sheets("DS-TH") 'Tim du lieu moi
    i = .Range("E" & Rows.Count).End(xlUp).Row
    If i < 4 Then MsgBox ("Khong co du lieu, thoat chuong trinh"): Exit Sub
    sArr = .Range("D4:L" & i).Value
  End With
  sRow = UBound(sArr)
  ReDim res(1 To UBound(sArr), 1 To 5)
  For i = 1 To sRow
    iKey = CStr(sArr(i, 2))
    If iKey <> Empty Then
      If dic.exists(iKey) = False Then
        k = k + 1
        res(k, 1) = sArr(i, 9)
        res(k, 2) = sArr(i, 2)
        res(k, 3) = sArr(i, 3)
        res(k, 4) = sArr(i, 1)
        res(k, 5) = sArr(i, 4)
        dic.Add iKey, ""
      End If
    End If
  Next i
  If k > 0 Then
    Sheets("DS TONG").Range("D" & eRow + 1).Resize(k, 5) = res
    MsgBox "Da Cap Nhat Them :   " & k & " Nhan Vien"
  Else
    MsgBox "Khong co Nhan Vien Moi!"
  End If
End Sub

Dạ cảm ơn Anh HieuCD
Em đã xem code OK rồi ạ, nếu phát sinh gì nữa em mở bài mới ạ.
Chúc Anh và cả nhà GPE một ngày vui!

bebo021999 · 9/11/21

Góp vui:

PHP:

Sub capnhat()
Dim Arr(), tArr() As Variant
Dim i, j
Dim aDic As Object
With Sheets("DS TONG")
.Range("A837:O1000").ClearContents
Set aDic = CreateObject("Scripting.Dictionary")
tArr = Sheets("DS-TH").Range("D390:L" & Range("E" & Rows.Count).End(xlUp).Row).Value
For i = 1 To UBound(tArr, 2)
    If Not IsEmpty(tArr(i, 2)) And Not aDic.exists(tArr(i, 2)) Then
        j = j + 1
        aDic.Add tArr(i, 2), i
        .Range("E" & 836 + j).Value = tArr(i, 2)
        .Range("D" & 836 + j).Value = tArr(i, 9)
        .Range("H" & 836 + j).Value = tArr(i, 4)
        .Range("F" & 836 + j).Value = tArr(i, 3)
        .Range("G" & 836 + j).Value = tArr(i, 1)
    End If
Next i
End With
End Sub

Maika8008 · 9/11/21

bebo021999 đã viết:

Góp vui:

PHP:

Sub capnhat()
Dim Arr(), tArr() As Variant
Dim i, j
Dim aDic As Object
With Sheets("DS TONG")
.Range("A837:O1000").ClearContents
Set aDic = CreateObject("Scripting.Dictionary")
tArr = Sheets("DS-TH").Range("D390:L" & Range("E" & Rows.Count).End(xlUp).Row).Value
For i = 1 To UBound(tArr, 2)
    If Not IsEmpty(tArr(i, 2)) And Not aDic.exists(tArr(i, 2)) Then
        j = j + 1
        aDic.Add tArr(i, 2), i
        .Range("E" & 836 + j).Value = tArr(i, 2)
        .Range("D" & 836 + j).Value = tArr(i, 9)
        .Range("H" & 836 + j).Value = tArr(i, 4)
        .Range("F" & 836 + j).Value = tArr(i, 3)
        .Range("G" & 836 + j).Value = tArr(i, 1)
    End If
Next i
End With
End Sub

Góp vui: khúc này bỏ được 5 chữ Value (chưa tính ở chỗ tArr bỏ 1 chữ nữa), kekeke --=0

.Range("E" & 836 + j) = tArr(i, 2)
.Range("D" & 836 + j) = tArr(i, 9)
.Range("H" & 836 + j) = tArr(i, 4)
.Range("F" & 836 + j) = tArr(i, 3)
.Range("G" & 836 + j) = tArr(i, 1)

bebo021999 · 9/11/21

Maika8008 đã viết:
Góp vui: khúc này bỏ được 5 chữ Value (chưa tính ở chỗ tArr bỏ 1 chữ nữa), kekeke

Em mới học code, còn nhiều thiếu sót ạ

Maika8008 · 9/11/21

bebo021999 đã viết:
Em mới học code, còn nhiều thiếu sót ạ

Hehe, tôi đùa chút ấy mà.

VBA code cập nhật theo điều kiện loại trùng

MeThuongNho

Thành viên thường trực

File đính kèm

snow25

Thành viên gạo cội

MeThuongNho

Thành viên thường trực

File đính kèm

HieuCD

Chuyên gia GPE

MeThuongNho

Thành viên thường trực

bebo021999

Thành viên gạo cội

Maika8008

Thành viên gạo cội

bebo021999

Thành viên gạo cội

Maika8008

Thành viên gạo cội

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng