Lấy dữ liệu mới không trùng với dữ liệu đã có và đổ vào sheet khác (3 người xem)

thufpts · 9/2/17

Dear các Bác.
em có vấn đề này mong các bác cứu giúp.
em có một file excel bao gồm 3 Sheet CONTROLLER, DATA, NEW
bây giờ em muốn lấy ra dữ liệu của của DATA không được trùng với CONTROLLER với điều kiện cột K chỉ lấy 01, và 02 và đổ vào sheet NEW.
tại sheet NEW em đã đặt sẵn các cột cần lấy của sheet DATA( từ A đến R)

Dữ liệu của sheet DATA và CONTROLLER có Cột A làm khóa chính để các bác tiện so sánh.
em không rành về vba lắm rất mong các bác giúp đỡ

ChanhTQ@ · 9/2/17

Bạn kiểm tra kết quả xen sao?

PHP:

Option Explicit
Sub ChépDL()
Dim Dict As Object, J As Long, W As Long, Z As Long, Col As Byte
Dim Arr() As Variant, sArr As Variant

With Sheets("Controller")
    Set Dict = CreateObject("Scripting.Dictionary")
    sArr = .Range(.[A2], .[A65500].End(xlUp)).Value
    For J = 1 To UBound(sArr, 1)
        If Not IsEmpty(sArr(J, 1)) And Not Dict.exists(sArr(J, 1)) Then
            W = W + 1
            Dict.Add sArr(J, 1), W
        Else
        End If
    Next J
End With
Z = W
With Sheets("Data")
    sArr = .Range(.[A2], .[A65500].End(xlUp)).Resize(, 24).Value
    ReDim Arr(1 To UBound(sArr, 1), 1 To 18)
    For J = 1 To UBound(sArr, 1)
        If Not IsEmpty(sArr(J, 1)) And Not Dict.exists(sArr(J, 1)) Then
            If sArr(J, 11) = "01" Or sArr(J, 11) = "02" Then
                Z = Z + 1
                Dict.Add sArr(J, 1), Z
                For Col = 1 To 18
                    Arr(Z - W, Col) = sArr(J, Col)
                Next Col
            End If
        End If
    Next J
End With
With Sheets("New")
    .[B2].CurrentRegion.Offset(1).ClearContents
    .Cells(2, "A").Resize(Z, 18).Value = Arr()
End With
End Sub

HieuCD · 9/2/17

thufpts đã viết:
Dear các Bác.
em có vấn đề này mong các bác cứu giúp.
em có một file excel bao gồm 3 Sheet CONTROLLER, DATA, NEW
bây giờ em muốn lấy ra dữ liệu của của DATA không được trùng với CONTROLLER với điều kiện cột K chỉ lấy 01, và 02 và đổ vào sheet NEW.
tại sheet NEW em đã đặt sẵn các cột cần lấy của sheet DATA( từ A đến R)
Dữ liệu của sheet DATA và CONTROLLER có Cột A làm khóa chính để các bác tiện so sánh.
em không rành về vba lắm rất mong các bác giúp đỡ

thử với code nầy xem sao

Mã:

Sub GPE()
Dim Darr(), Sarr(), Dic As Object, i As Long, Rng As Range
Set Dic = CreateObject("Scripting.Dictionary")
Darr = Sheets("DATA").Range("A1:R" & Sheets("DATA").Range("A65500").End(xlUp).Row).Value
Sarr = Sheets("CONTROLLER").Range("A2:A" & Sheets("CONTROLLER").Range("A65500").End(xlUp).Row).Value
For i = 1 To UBound(Sarr)
  If Not Dic.exists(Sarr(i, 1)) Then Dic.Add (Sarr(i, 1)), ""
Next i
With Sheets("DATA")
  Set Rng = .Range("A1:R1")
  For i = 2 To UBound(Darr)
    If Not Dic.exists(Darr(i, 1)) And (Darr(i, 11) = "01" Or Darr(i, 11) = "02") Then
      Set Rng = Application.Union(Rng, .Range("A" & i & ":R" & i))
    End If
  Next i
End With
Rng.Copy Sheets("NEW").Range("A1")
Set Rng = Nothing
End Sub

thufpts · 9/2/17

HieuCD đã viết:

thử với code nầy xem sao

Mã:

Sub GPE()
Dim Darr(), Sarr(), Dic As Object, i As Long, Rng As Range
Set Dic = CreateObject("Scripting.Dictionary")
Darr = Sheets("DATA").Range("A1:R" & Sheets("DATA").Range("A65500").End(xlUp).Row).Value
Sarr = Sheets("CONTROLLER").Range("A2:A" & Sheets("CONTROLLER").Range("A65500").End(xlUp).Row).Value
For i = 1 To UBound(Sarr)
  If Not Dic.exists(Sarr(i, 1)) Then Dic.Add (Sarr(i, 1)), ""
Next i
With Sheets("DATA")
  Set Rng = .Range("A1:R1")
  For i = 2 To UBound(Darr)
    If Not Dic.exists(Darr(i, 1)) And (Darr(i, 11) = "01" Or Darr(i, 11) = "02") Then
      Set Rng = Application.Union(Rng, .Range("A" & i & ":R" & i))
    End If
  Next i
End With
Rng.Copy Sheets("NEW").Range("A1")
Set Rng = Nothing
End Sub

Cám ơn bác. bác có thể giúp em vừa đổ vào sheet new và vừa đổ dữ liệu kế tiếp vào sheet CONTROLLER mà không làm mất dữ liệu cũ được không bác.
mục đích của em là muốn biết được có bao nhiêu item được tao mới trong sheet new và số item vừa tạo ra đó sẽ điền luôn kế tiếp vào sheet controller để em không phải copy nhiều
rất dễ nhầm. mong bác giúp em

thufpts · 9/2/17

ChanhTQ@ đã viết:

PHP:

Option Explicit
Sub ChépDL()
Dim Dict As Object, J As Long, W As Long, Z As Long, Col As Byte
Dim Arr() As Variant, sArr As Variant

With Sheets("Controller")
    Set Dict = CreateObject("Scripting.Dictionary")
    sArr = .Range(.[A2], .[A65500].End(xlUp)).Value
    For J = 1 To UBound(sArr, 1)
        If Not IsEmpty(sArr(J, 1)) And Not Dict.exists(sArr(J, 1)) Then
            W = W + 1
            Dict.Add sArr(J, 1), W
        Else
        End If
    Next J
End With
Z = W
With Sheets("Data")
    sArr = .Range(.[A2], .[A65500].End(xlUp)).Resize(, 24).Value
    ReDim Arr(1 To UBound(sArr, 1), 1 To 18)
    For J = 1 To UBound(sArr, 1)
        If Not IsEmpty(sArr(J, 1)) And Not Dict.exists(sArr(J, 1)) Then
            If sArr(J, 11) = "01" Or sArr(J, 11) = "02" Then
                Z = Z + 1
                Dict.Add sArr(J, 1), Z
                For Col = 1 To 18
                    Arr(Z - W, Col) = sArr(J, Col)
                Next Col
            End If
        End If
    Next J
End With
With Sheets("New")
    .[B2].CurrentRegion.Offset(1).ClearContents
    .Cells(2, "A").Resize(Z, 18).Value = Arr()
End With
End Sub

em cám ơn bác nhiều lắm. em chưa test hết nhưng nó chạy được rồi. đa tạ bác

HieuCD · 9/2/17

thufpts đã viết:
Cám ơn bác. bác có thể giúp em vừa đổ vào sheet new và vừa đổ dữ liệu kế tiếp vào sheet CONTROLLER mà không làm mất dữ liệu cũ được không bác.
mục đích của em là muốn biết được có bao nhiêu item được tao mới trong sheet new và số item vừa tạo ra đó sẽ điền luôn kế tiếp vào sheet controller để em không phải copy nhiều
rất dễ nhầm. mong bác giúp em

bạn chạy code

Mã:

Sub GPE()
Dim Darr(), sArr(), Dic As Object, i As Long, LastR As Long, Rng As Range
Set Dic = CreateObject("Scripting.Dictionary")
Darr = Sheets("DATA").Range("A1:R" & Sheets("DATA").Range("A65500").End(xlUp).Row).Value
LastR = Sheets("CONTROLLER").Range("A65500").End(xlUp).Row
sArr = Sheets("CONTROLLER").Range("A2:A" & LastR).Value
For i = 1 To UBound(sArr)
  If Not Dic.exists(sArr(i, 1)) Then Dic.Add (sArr(i, 1)), ""
Next i
With Sheets("DATA")
  For i = 2 To UBound(Darr)
    If Not Dic.exists(Darr(i, 1)) And (Darr(i, 11) = "01" Or Darr(i, 11) = "02") Then
      If Rng Is Nothing Then
        Set Rng = .Range("A" & i & ":R" & i)
      Else
        Set Rng = Application.Union(Rng, .Range("A" & i & ":R" & i))
      End If
    End If
  Next i
End With
Sheets("NEW").Range("A2:R20000").ClearContents
Rng.Copy Sheets("NEW").Range("A2")
Rng.Copy Sheets("CONTROLLER").Range("A" & LastR + 1)
Set Rng = Nothing:  Set Dic = Nothing
End Sub

thufpts · 9/2/17

HieuCD đã viết:

bạn chạy code

Mã:

Sub GPE()
Dim Darr(), sArr(), Dic As Object, i As Long, LastR As Long, Rng As Range
Set Dic = CreateObject("Scripting.Dictionary")
Darr = Sheets("DATA").Range("A1:R" & Sheets("DATA").Range("A65500").End(xlUp).Row).Value
LastR = Sheets("CONTROLLER").Range("A65500").End(xlUp).Row
sArr = Sheets("CONTROLLER").Range("A2:A" & LastR).Value
For i = 1 To UBound(sArr)
  If Not Dic.exists(sArr(i, 1)) Then Dic.Add (sArr(i, 1)), ""
Next i
With Sheets("DATA")
  For i = 2 To UBound(Darr)
    If Not Dic.exists(Darr(i, 1)) And (Darr(i, 11) = "01" Or Darr(i, 11) = "02") Then
      If Rng Is Nothing Then
        Set Rng = .Range("A" & i & ":R" & i)
      Else
        Set Rng = Application.Union(Rng, .Range("A" & i & ":R" & i))
      End If
    End If
  Next i
End With
Sheets("NEW").Range("A2:R20000").ClearContents
Rng.Copy Sheets("NEW").Range("A2")
Rng.Copy Sheets("CONTROLLER").Range("A" & LastR + 1)
Set Rng = Nothing:  Set Dic = Nothing
End Sub

Em chạy code nó chỉ add được vào sheet controller chứ không add được vào sheet new. với lại em chạy lần 1 không báo lỗi chạy lần 2 nó báo lỗi
Rng.Copy Sheets("NEW").Range("A2")

Nguyễn Hồng Quang · 9/2/17

Mình có xem file của bạn. Nhưng có 1 chỗ mình ko hiểu cho mình hỏi thêm chút
Dữ liệu trùng giữa 2 sheet Controller và Data được bạn hiểu như thế nào
Có phải là tất cả dũ liệu của 15 cột của 1 dòng dữ liệu (sheet Controller) mà đều bằng dữ liệu của 15/24 cột của 1 dòng dữ liệu tương ứng (sheet Data) thì hiều là trùng phải không bạn
Nếu mà so sánh kiểu đấy thì chẳng có dòng dữ liệu nào trùng cả vì mình thấy Cột Reload của Sheet Controller có số 1 còn Cột Reload của sheet Data ko có dữ liệu
Bạn có thể trình bày thêm về định nghĩa trùng dữ liệu giữa các sheet được ko bạn

thufpts · 9/2/17

Nguyễn Hồng Quang đã viết:
Mình có xem file của bạn. Nhưng có 1 chỗ mình ko hiểu cho mình hỏi thêm chút
Dữ liệu trùng giữa 2 sheet Controller và Data được bạn hiểu như thế nào
Có phải là tất cả dũ liệu của 15 cột của 1 dòng dữ liệu (sheet Controller) mà đều bằng dữ liệu của 15/24 cột của 1 dòng dữ liệu tương ứng (sheet Data) thì hiều là trùng phải không bạn
Nếu mà so sánh kiểu đấy thì chẳng có dòng dữ liệu nào trùng cả vì mình thấy Cột Reload của Sheet Controller có số 1 còn Cột Reload của sheet Data ko có dữ liệu
Bạn có thể trình bày thêm về định nghĩa trùng dữ liệu giữa các sheet được ko bạn

Dear Bạn.
1. Đúng như bạn nói sheet CONTROLLER trùng với DATA. 2 cột khóa chính là SKU của 2 sheet. mình chỉ muốn so sánh 2 trường này thôi, còn không phải
tất cả các cột có dữ liệu giống nhau.
2. Cột reload lúc đầu mình định dung access để so sánh số 1 trong CONTROLLER là dữ liệu cũ còn 0 bên DATA là dữ liệu mới đấy là theo cách mình tổ chức dữ liệu thôi nhưng làm mãi không được nên đành viết lên đầy giờ các bác giúp.

Mình cám ơn

HieuCD · 9/2/17

thufpts đã viết:
Em chạy code nó chỉ add được vào sheet controller chứ không add được vào sheet new. với lại em chạy lần 1 không báo lỗi chạy lần 2 nó báo lỗi
Rng.Copy Sheets("NEW").Range("A2")

chạy lần 1 nó copy cả 2 sheet bình thường
chạy lần 2 sheet CONTROLLER có thêm dữ liệu, nên dữ liệu sheet DATA không thỏa điều kiện và báo lổi
code thêm phần bẩy lổi, và chỉnh lại tăng tốc độ

Mã:

Sub GPE()
Dim Drng As Range, sArr(), Dic As Object, i As Long, R As Long, LastR As Long, Rng As Range
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
R = Sheets("DATA").Range("A65500").End(xlUp).Row
Set Drng = Sheets("DATA").Range("A2:R" & R)
LastR = Sheets("CONTROLLER").Range("A65500").End(xlUp).Row
sArr = Sheets("CONTROLLER").Range("A2:A" & LastR).Value
For i = 1 To UBound(sArr)
  If Not Dic.exists(sArr(i, 1)) Then Dic.Add (sArr(i, 1)), ""
Next i
For i = 1 To R - 1
  If Not Dic.exists(Drng(i, 1).Value) And (Drng(i, 11) = "01" Or Drng(i, 11) = "02") Then
    k = k + 1
    If Rng Is Nothing Then
      Set Rng = Range(Drng(i, 1), Drng(i, 18))
    Else
      Set Rng = Application.Union(Rng, Range(Drng(i, 1), Drng(i, 18)))
    End If
  End If
Next i
Sheets("NEW").Range("A2:R20000").ClearContents
If Not Rng Is Nothing Then
  Rng.Copy Sheets("NEW").Range("A2")
  Rng.Copy Sheets("CONTROLLER").Range("A" & LastR + 1)
Else
  MsgBox ("Khong tim thay du lieu thoa dieu kien")
End If
Application.ScreenUpdating = True
End Sub

thufpts · 10/2/17

HieuCD đã viết:

chạy lần 1 nó copy cả 2 sheet bình thường
chạy lần 2 sheet CONTROLLER có thêm dữ liệu, nên dữ liệu sheet DATA không thỏa điều kiện và báo lổi
code thêm phần bẩy lổi, và chỉnh lại tăng tốc độ

Mã:

Sub GPE()
Dim Drng As Range, sArr(), Dic As Object, i As Long, R As Long, LastR As Long, Rng As Range
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
R = Sheets("DATA").Range("A65500").End(xlUp).Row
Set Drng = Sheets("DATA").Range("A2:R" & R)
LastR = Sheets("CONTROLLER").Range("A65500").End(xlUp).Row
sArr = Sheets("CONTROLLER").Range("A2:A" & LastR).Value
For i = 1 To UBound(sArr)
  If Not Dic.exists(sArr(i, 1)) Then Dic.Add (sArr(i, 1)), ""
Next i
For i = 1 To R - 1
  If Not Dic.exists(Drng(i, 1).Value) And (Drng(i, 11) = "01" Or Drng(i, 11) = "02") Then
    k = k + 1
    If Rng Is Nothing Then
      Set Rng = Range(Drng(i, 1), Drng(i, 18))
    Else
      Set Rng = Application.Union(Rng, Range(Drng(i, 1), Drng(i, 18)))
    End If
  End If
Next i
Sheets("NEW").Range("A2:R20000").ClearContents
If Not Rng Is Nothing Then
  Rng.Copy Sheets("NEW").Range("A2")
  Rng.Copy Sheets("CONTROLLER").Range("A" & LastR + 1)
Else
  MsgBox ("Khong tim thay du lieu thoa dieu kien")
End If
Application.ScreenUpdating = True
End Sub

cảm ơn bác rất nhiều. em check có gì em lại nhờ bác fix giúp.

thufpts · 10/2/17

HieuCD đã viết:

chạy lần 1 nó copy cả 2 sheet bình thường
chạy lần 2 sheet CONTROLLER có thêm dữ liệu, nên dữ liệu sheet DATA không thỏa điều kiện và báo lổi
code thêm phần bẩy lổi, và chỉnh lại tăng tốc độ

Mã:

Sub GPE()
Dim Drng As Range, sArr(), Dic As Object, i As Long, R As Long, LastR As Long, Rng As Range
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
R = Sheets("DATA").Range("A65500").End(xlUp).Row
Set Drng = Sheets("DATA").Range("A2:R" & R)
LastR = Sheets("CONTROLLER").Range("A65500").End(xlUp).Row
sArr = Sheets("CONTROLLER").Range("A2:A" & LastR).Value
For i = 1 To UBound(sArr)
  If Not Dic.exists(sArr(i, 1)) Then Dic.Add (sArr(i, 1)), ""
Next i
For i = 1 To R - 1
  If Not Dic.exists(Drng(i, 1).Value) And (Drng(i, 11) = "01" Or Drng(i, 11) = "02") Then
    k = k + 1
    If Rng Is Nothing Then
      Set Rng = Range(Drng(i, 1), Drng(i, 18))
    Else
      Set Rng = Application.Union(Rng, Range(Drng(i, 1), Drng(i, 18)))
    End If
  End If
Next i
Sheets("NEW").Range("A2:R20000").ClearContents
If Not Rng Is Nothing Then
  Rng.Copy Sheets("NEW").Range("A2")
  Rng.Copy Sheets("CONTROLLER").Range("A" & LastR + 1)
Else
  MsgBox ("Khong tim thay du lieu thoa dieu kien")
End If
Application.ScreenUpdating = True
End Sub

Dear Bác HieuCD.
Code chạy rất ok. Nhưng bác giúp em vấn đề này được không vì tại lúc đầu đăng bài viết lên em không biết diễn tả sao cho bác hiểu.
phải đợi vào vấn đề em mới mô tả được như sau.
Hiện tại sheet CONTROLLER đã có dữ liệu được lấy ra từ sheet DATA nhưng các cột J,K,M,L của Sheet DATA luôn luôn bị thay đổi.
vì vậy em muốn các cột của sheet CONTROLLER cũng phải thay đổi theo và phải tuân theo các điều kiện sau đây.

1. Cột K tại sheet CONTROLLER sẽ thay đổi theo cột K của sheet DATA cho đến khi nào K của DATA =95 và giữ nguyên giá trị 95 dù cho K của DATA bị mất đi. em ví dụ SKU 970279-YW0CLN-FAR-32A của CONTROLLER thay đổi theo SKU 970279-YW0CLN-FAR-32A của DATA( thay đổi các cột mà em vừa trình bày) đến
khi SKU 970279-YW0CLN-FAR-32A của DATA =95 thì SKU 970279-YW0CLN-FAR-32A của CONTROLLER sẽ được giữ nguyên giá trị là 95.
Nếu như SKU 970279-YW0CLN-FAR-32A của DATA về sau này có bị mất đi thì SKU 970279-YW0CLN-FAR-32A của CONTROLER phải còn nguyên 95.

2. Cột J,K,L của CONTROLLER thay đổi theo J,K,L của DATA cho đến khi K của DATA =35 và giữ nguyên không đổi dù cho SKU của DATA sau này có bị xóa đi.

Em không biết em giải thích yêu cầu như vậy có rõ ràng để bác hiểu chưa. Nhưng em rất hy vọng bác sẽ giúp được em.
Em gửi lại file đính kèm. Bác xem theo file mới giúp em.
Em cám ơn.

HieuCD · 10/2/17

thufpts đã viết:
Dear Bác HieuCD.
Code chạy rất ok. Nhưng bác giúp em vấn đề này được không vì tại lúc đầu đăng bài viết lên em không biết diễn tả sao cho bác hiểu.
phải đợi vào vấn đề em mới mô tả được như sau.
Hiện tại sheet CONTROLLER đã có dữ liệu được lấy ra từ sheet DATA nhưng các cột J,K,M,L của Sheet DATA luôn luôn bị thay đổi.
vì vậy em muốn các cột của sheet CONTROLLER cũng phải thay đổi theo và phải tuân theo các điều kiện sau đây.
1. Cột K tại sheet CONTROLLER sẽ thay đổi theo cột K của sheet DATA cho đến khi nào K của DATA =95 và giữ nguyên giá trị 95 dù cho K của DATA bị mất đi. em ví dụ SKU 970279-YW0CLN-FAR-32A của CONTROLLER thay đổi theo SKU 970279-YW0CLN-FAR-32A của DATA( thay đổi các cột mà em vừa trình bày) đến
khi SKU 970279-YW0CLN-FAR-32A của DATA =95 thì SKU 970279-YW0CLN-FAR-32A của CONTROLLER sẽ được giữ nguyên giá trị là 95.
Nếu như SKU 970279-YW0CLN-FAR-32A của DATA về sau này có bị mất đi thì SKU 970279-YW0CLN-FAR-32A của CONTROLER phải còn nguyên 95.
2. Cột J,K,L của CONTROLLER thay đổi theo J,K,L của DATA cho đến khi K của DATA =35 và giữ nguyên không đổi dù cho SKU của DATA sau này có bị xóa đi.
Em không biết em giải thích yêu cầu như vậy có rõ ràng để bác hiểu chưa. Nhưng em rất hy vọng bác sẽ giúp được em.
Em gửi lại file đính kèm. Bác xem theo file mới giúp em.
Em cám ơn.

mình diễn đạt lại cho rỏ:

- vẫn trích dữ liệu vào sheet NEW như code trước?

các dữ liệu có sẵn của CONTROLLER:
- Nếu cột K của CONTROLLER khác 95 sẽ tính lại cột K theo DATA dựa vào giá trị tương ứng của SKU?
- Nếu cột K của CONTROLLER khác 35 sẽ tính lại các cột J,L,M theo DATA?
Nếu không tìm thấy SKU trên DATA thì không thay đổi cả 2 ý trên?

thufpts · 10/2/17

HieuCD đã viết:
mình diễn đạt lại cho rỏ:

- vẫn trích dữ liệu vào sheet NEW như code trước?

các dữ liệu có sẵn của CONTROLLER:
-Nếu cột K của CONTROLLER khác 95 sẽ tính lại cột K theo DATA dựa vào giá trị tương ứng của SKU?
- Nếu cột K của CONTROLLER khác 35 sẽ tính lại các cột J,L,M theo DATA?
Nếu không tìm thấy SKU trên DATA thì không thay đổi cả 2 ý trên?

Dear bác, em trả lời theo các ý của bác như sau.

- vẫn trích dữ liệu vào sheet NEW như code trước

các dữ liệu có sẵn của CONTROLLER:
-Nếu cột K của CONTROLLER khác 95 sẽ tính lại cột K theo DATA dựa vào giá trị tương ứng của SKU
- Nếu cột K của CONTROLLER < 35 sẽ tính lại các cột J,L,M theo DATA
Nếu không tìm thấy SKU trên DATA thì không thay đổi cả 2 ý trên
Chính xác chỉ còn khác 35 thay bằng < 35 thôi.

HieuCD · 11/2/17

thufpts đã viết:
Dear bác, em trả lời theo các ý của bác như sau.

- vẫn trích dữ liệu vào sheet NEW như code trước

các dữ liệu có sẵn của CONTROLLER:
-Nếu cột K của CONTROLLER khác 95 sẽ tính lại cột K theo DATA dựa vào giá trị tương ứng của SKU
- Nếu cột K của CONTROLLER < 35 sẽ tính lại các cột J,L,M theo DATA
Nếu không tìm thấy SKU trên DATA thì không thay đổi cả 2 ý trên
Chính xác chỉ còn khác 35 thay bằng < 35 thôi.

bạn chạy thử code, chú ý chổ màu đỏ để chỉnh lại cho phù hợp

Mã:

Sub GPE1()
Dim DR As Range, Rng As Range, Sarr(), Dic As Object, DicD As Object
Dim i   As Long, R As Long, LastR As Long, Tmp As String
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
Set DicD = CreateObject("Scripting.Dictionary")
R = Sheets("DATA").Range("A65500").End(xlUp).Row
Set DR = Sheets("DATA").Range("A2:R" & R)
LastR = Sheets("CONTROLLER").Range("A65500").End(xlUp).Row
Sarr = Sheets("CONTROLLER").Range("A2:M" & LastR).Value
For i = 1 To UBound(Sarr)
  Tmp = Sarr(i, 1)
  If Not Dic.exists(Tmp) Then Dic.Add (Tmp), ""
Next i
For i = 1 To R - 1
  Tmp = DR(i, 1).Value
  If Not Dic.exists(Tmp) Then
    If DR(i, 11) = "02" Then
      k = k + 1
      If Rng Is Nothing Then
        Set Rng = Range(DR(i, 1), DR(i, 18))
      Else
        Set Rng = Application.Union(Rng, Range(DR(i, 1), DR(i, 18)))
      End If
    End If
  Else
    If Not DicD.exists(Tmp) Then DicD.Add (Tmp), _
        Array(DR(i, 10).Value, DR(i, 11).Value, DR(i, 12).Value, DR(i, 13).Value)
  End If
Next i
For i = 1 To UBound(Sarr)
  Tmp = Sarr(i, 1)
  If DicD.exists(Tmp) Then
[COLOR=#ff0000]    If Sarr(i, 11) < 95 Then[/COLOR]
      Sarr(i, 11) = Format(DicD.Item(Tmp)(1), "@@")
    End If
[COLOR=#ff0000]    If Sarr(i, 11) < 35 Then[/COLOR]
      Sarr(i, 10) = DicD.Item(Tmp)(0)
      Sarr(i, 12) = DicD.Item(Tmp)(2)
      Sarr(i, 13) = DicD.Item(Tmp)(3)
    End If
  End If
Next i
Sheets("CONTROLLER").Range("K2").Resize(LastR - 1).NumberFormat = "@"
Sheets("CONTROLLER").Range("A2").Resize(LastR - 1, 13) = Sarr
If Not Rng Is Nothing Then
  Sheets("NEW").Range("A2:R20000").ClearContents
  Rng.Copy Sheets("NEW").Range("A2")
  Rng.Copy Sheets("CONTROLLER").Range("A" & LastR + 1)
Else
  MsgBox ("Khong tim thay du lieu them moi")
End If
Application.ScreenUpdating = True
End Sub

VetMini · 12/2/17

@HieuCD:
Như thế này sẽ tránh được phải bảo dic gọi item(tmp) nhiều lần

Mã:

Dim Var as Variant
For i = 1 To UBound(Sarr)
  If DicD.exists(Sarr(i, 1)) Then
    Var = DicD.Item(Sarr(i, 1))
[COLOR=#ff0000]    If Sarr(i, 11) < 95 Then[/COLOR]
      Sarr(i, 11) = Format(Var(1), "@@")
    End If
[COLOR=#ff0000]    If Sarr(i, 11) < 35 Then[/COLOR]
      Sarr(i, 10) = Var(0)
      Sarr(i, 12) = Var(2)
      Sarr(i, 13) = Var(3)
    End If
  End If
Next i

HieuCD · 12/2/17

VetMini đã viết:
@HieuCD:
Như thế này sẽ tránh được phải bảo dic gọi item(tmp) nhiều lần

Mã:

Dim Var as Variant For i = 1 To UBound(Sarr) If DicD.exists(Sarr(i, 1)) Then Var = DicD.Item(Sarr(i, 1)) [COLOR=#ff0000] If Sarr(i, 11) < 95 Then[/COLOR] Sarr(i, 11) = Format(Var(1), "@@") End If [COLOR=#ff0000] If Sarr(i, 11) < 35 Then[/COLOR] Sarr(i, 10) = Var(0) Sarr(i, 12) = Var(2) Sarr(i, 13) = Var(3) End If End If Next i

cám ơn bạn, nhiều kiến thức nếu không có bạn và các bạn khác trên diễn đàn có lẽ mình không bao giờ biết được
chúc bạn một ngày chủ nhật vui /-*+/

thufpts · 12/2/17

HieuCD đã viết:
cám ơn bạn, nhiều kiến thức nếu không có bạn và các bạn khác trên diễn đàn có lẽ mình không bao giờ biết được
chúc bạn một ngày chủ nhật vui

Dear Bác HieuCD em không biết cám ơn bác như thế nào cho đủ. nếu em không có những người như bác thì em mãi là nông dân quèn.
trân trọng cám ơn bác.

VetMini · 12/2/17

Thời đại tiên tiến này khó hiểu quá, ngừoi xưng là nông dân quèn cũng xổ tiếng tây bôm bốp. Cỡ không biết tiếng tây như mình được tính là gì đây? cùng đinh?

thufpts · 13/2/17

VetMini đã viết:
Thời đại tiên tiến này khó hiểu quá, ngừoi xưng là nông dân quèn cũng xổ tiếng tây bôm bốp. Cỡ không biết tiếng tây như mình được tính là gì đây? cùng đinh?

Hoho tiếng tây hê lô bai bai thì em biết. mấy cái sheet tiếng anh đấy là đổ từ hệ thống ra nó quy định vậy mà mọi người quen miệng đọc thôi. chứ tây gì đâu.
các bác viết code thì mới tây được, bác cứ khiêm tốn rồi /-*+/

Lấy dữ liệu mới không trùng với dữ liệu đã có và đổ vào sheet khác (3 người xem)

Người dùng đang xem chủ đề này

Thành viên hoạt động

File đính kèm

0901452không62

Chuyên gia GPE

Thành viên hoạt động

Thành viên hoạt động

Chuyên gia GPE

Thành viên hoạt động

Thành viên GPE Hà Nội

Thành viên hoạt động

Chuyên gia GPE

Thành viên hoạt động

Thành viên hoạt động

File đính kèm

Chuyên gia GPE

Thành viên hoạt động

Chuyên gia GPE

Ăn cùng góc phố

Chuyên gia GPE

Thành viên hoạt động

Ăn cùng góc phố

Thành viên hoạt động

Đếm ngược thời gian