Lấy dữ liệu mới không trùng với dữ liệu đã có và đổ vào sheet khác (2 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 đỡ

HieuCD · 1/3/17

bạn kiểm tra lại code

Mã:

Sub GPE()
Dim DR As Range, Rng As Range, Dic As Object, Dic35 As Object, Dic95 As Object
Dim Sarr(), S_UX(), UXarr(), i As Long, R As Long, LastR As Long, Tmp As String
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
Set Dic35 = CreateObject("Scripting.Dictionary")
Set Dic95 = 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:N" & LastR).Value
S_UX = Sheets("CONTROLLER").Range("S2:W" & LastR).Value
UXarr = Sheets("UX").Range("A2:Q" & Sheets("UX").Range("A65500").End(xlUp).Row).Value
For i = 1 To UBound(Sarr)
  Tmp = Sarr(i, 1)
  Dic.Add (Tmp), i
  If Sarr(i, 11) < 95 Then
    Dic95.Add (Tmp), i
    If Sarr(i, 11) <= 35 Then Dic35.Add (Tmp), i
  End If
Next i
For i = 1 To R - 1
  Tmp = DR(i, 1).Value
  If Not Dic.exists(Tmp) Then
    If DR(i, 11) >= "02" And DR(i, 11) <= "33" Then
      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 Dic95.exists(Tmp) Then
      k = Dic95.Item(Tmp)
      Sarr(k, 11) = Format(DR(i, 11), "@@")
      If Dic35.exists(Tmp) Then
        k = Dic35.Item(Tmp)
        Sarr(k, 10) = DR(i, 10)
        Sarr(k, 12) = DR(i, 12)
        Sarr(k, 13) = DR(i, 13)
        Sarr(k, 14) = DR(i, 14)
      End If
    End If
  End If
Next i
For i = 1 To UBound(UXarr)
  Tmp = UXarr(i, 1)
  If Dic.exists(Tmp) Then
    n = Dic.Item(Tmp)
    S_UX(n, 1) = UXarr(i, 13)
    S_UX(n, 2) = UXarr(i, 14)
    S_UX(n, 3) = UXarr(i, 15)
    S_UX(n, 4) = UXarr(i, 16)
    S_UX(n, 5) = UXarr(i, 17)
  End If
Next i
If k Then
  Sheets("CONTROLLER").Range("I2").Resize(LastR - 1).NumberFormat = "@"
  Sheets("CONTROLLER").Range("K2").Resize(LastR - 1).NumberFormat = "@"
  Sheets("CONTROLLER").Range("A2").Resize(LastR - 1, 14) = Sarr
  MsgBox ("Old Row Is Updated From Data")
End If
If n Then
  Sheets("CONTROLLER").Range("S2").Resize(LastR - 1, 5) = S_UX
  MsgBox ("Old Row Is Updated From UX")
End If
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)
  MsgBox ("Updated New Row")
Else
  MsgBox ("No Row Inserted")
End If
Application.ScreenUpdating = True
End Sub

thufpts · 3/3/17

HieuCD đã viết:

bạn kiểm tra lại code

Mã:

Sub GPE()
Dim DR As Range, Rng As Range, Dic As Object, Dic35 As Object, Dic95 As Object
Dim Sarr(), S_UX(), UXarr(), i As Long, R As Long, LastR As Long, Tmp As String
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
Set Dic35 = CreateObject("Scripting.Dictionary")
Set Dic95 = 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:N" & LastR).Value
S_UX = Sheets("CONTROLLER").Range("S2:W" & LastR).Value
UXarr = Sheets("UX").Range("A2:Q" & Sheets("UX").Range("A65500").End(xlUp).Row).Value
For i = 1 To UBound(Sarr)
  Tmp = Sarr(i, 1)
  Dic.Add (Tmp), i
  [COLOR=#ff0000]If Sarr(i, 10) < 95 Then[/COLOR]
    Dic95.Add (Tmp), i
    [COLOR=#ff0000]If Sarr(i, 10) <= 35 Then Dic35.Add (Tmp), i[/COLOR]
  End If
Next i
For i = 1 To R - 1
  Tmp = DR(i, 1).Value
  If Not Dic.exists(Tmp) Then
   [COLOR=#ff0000]If DR(i, 10) >= "02" And DR(i, 10) <= "33" Then[/COLOR]
      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 Dic95.exists(Tmp) Then
      k = Dic95.Item(Tmp)
      [COLOR=#ff0000]Sarr(k, 10) = Format(DR(i, 10), "@@")[/COLOR]
      If Dic35.exists(Tmp) Then
        k = Dic35.Item(Tmp)
        [COLOR=#ff0000]Sarr(k, 10) = DR(i, 11)[/COLOR]
        Sarr(k, 12) = DR(i, 12)
        Sarr(k, 13) = DR(i, 13)
        Sarr(k, 14) = DR(i, 14)
      End If
    End If
  End If
Next i
For i = 1 To UBound(UXarr)
  Tmp = UXarr(i, 1)
  If Dic.exists(Tmp) Then
    n = Dic.Item(Tmp)
    S_UX(n, 1) = UXarr(i, 13)
    S_UX(n, 2) = UXarr(i, 14)
    S_UX(n, 3) = UXarr(i, 15)
    S_UX(n, 4) = UXarr(i, 16)
    S_UX(n, 5) = UXarr(i, 17)
  End If
Next i
If k Then
  Sheets("CONTROLLER").Range("I2").Resize(LastR - 1).NumberFormat = "@"
  [COLOR=#ff0000]Sheets("CONTROLLER").Range("J2").Resize(LastR - 1).NumberFormat = "@"[/COLOR]
  Sheets("CONTROLLER").Range("A2").Resize(LastR - 1, 14) = Sarr
  MsgBox ("Old Row Is Updated From Data")
End If
If n Then
  Sheets("CONTROLLER").Range("S2").Resize(LastR - 1, 5) = S_UX
  MsgBox ("Old Row Is Updated From UX")
End If
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)
  MsgBox ("Updated New Row")
Else
  MsgBox ("No Row Inserted")
End If
Application.ScreenUpdating = True
End Sub

Cám ơn bác em đã chạy ngon rồi. Nếu em muốn đổi cột liệu có đổi được không bác. em chỉ đổi vị trí cột STATUS của các sheet DATA, NEW, CONTROLLER từ K về J sau đó
em sửa lại code em đã bôi màu. nó báo lỗi ngay từ If Sarr(i, 10) < 95 Then. em rất xin lỗi vì đã hỏi vặt bác nhưng em chẳng biết nhờ ai nữa.

HieuCD · 3/3/17

thufpts đã viết:
Cám ơn bác em đã chạy ngon rồi. Nếu em muốn đổi cột liệu có đổi được không bác. em chỉ đổi vị trí cột STATUS của các sheet DATA, NEW, CONTROLLER từ K về J sau đó
em sửa lại code em đã bôi màu. nó báo lỗi ngay từ If Sarr(i, 10) < 95 Then. em rất xin lỗi vì đã hỏi vặt bác nhưng em chẳng biết nhờ ai nữa.

mình cũng không biết tại sao bị lỗi
bạn chạy code, khi báo lỗi, bạn rà chuột vào dòng lệnh lỗi, chổ Sarr(i, 10) xem nó hiện kết quả là gì mới biết được, hoặc bạn gởi file xem sao
giờ mình bận, thứ 2 mới rảnh

thufpts · 6/3/17

HieuCD đã viết:
mình cũng không biết tại sao bị lỗi
bạn chạy code, khi báo lỗi, bạn rà chuột vào dòng lệnh lỗi, chổ Sarr(i, 10) xem nó hiện kết quả là gì mới biết được, hoặc bạn gởi file xem sao
giờ mình bận, thứ 2 mới rảnh

Dear Bác HieuCD. em đã xóa hết dữ liệu sheet CONTROLLER và chạy lại thì nó không báo lỗi nữa.
em nghĩ có lẽ nó chạy được rồi em hi vọng nó ko có vấn đề gì. cám ơn bác rất nhiều.

thufpts · 13/3/17

HieuCD đã viết:
mình cũng không biết tại sao bị lỗi
bạn chạy code, khi báo lỗi, bạn rà chuột vào dòng lệnh lỗi, chổ Sarr(i, 10) xem nó hiện kết quả là gì mới biết được, hoặc bạn gởi file xem sao
giờ mình bận, thứ 2 mới rảnh

Bác HieuCD ơi. nếu em click button GPE mà bên sheet CONTROLLER em ẩn một số cột đi thì nó sẽ copy và cập nhật sai hết vị trí. liệu có cách nào khắc phục không bác.

HieuCD · 13/3/17

thufpts đã viết:
Bác HieuCD ơi. nếu em click button GPE mà bên sheet CONTROLLER em ẩn một số cột đi thì nó sẽ copy và cập nhật sai hết vị trí. liệu có cách nào khắc phục không bác.

đầu sub bạn dùng lệnh để Unhide cột

Mã:

Cells.EntireColumn.Hidden = False

cuối sub bạn dùng code dạng sau để ẩn cột

Mã:

Columns("[COLOR=#ff0000]E:G[/COLOR]").EntireColumn.Hidden = True

thufpts · 14/3/17

HieuCD đã viết:
đầu sub bạn dùng lệnh để Unhide cột

Mã:

Cells.EntireColumn.Hidden = False

cuối sub bạn dùng code dạng sau để ẩn cột

Mã:

Columns("[COLOR=#ff0000]E:G[/COLOR]").EntireColumn.Hidden = True

đối với dòng khi em lọc có dùng được cách này không bác

thufpts · 14/3/17

HieuCD đã viết:
đầu sub bạn dùng lệnh để Unhide cột

Mã:

Cells.EntireColumn.Hidden = False

cuối sub bạn dùng code dạng sau để ẩn cột

Mã:

Columns("[COLOR=#ff0000]E:G[/COLOR]").EntireColumn.Hidden = True

Ôi nó đơ không chạy được bác ạ. bác giúp em với áp dụng cả dòng và cột.
em cám ơn

HieuCD · 14/3/17

thufpts đã viết:
Ôi nó đơ không chạy được bác ạ. bác giúp em với áp dụng cả dòng và cột.
em cám ơn

đối với dòng phải biết bạn ẩn bằng cách nào mới làm được
tốt nhất bạn bỏ ẩn dòng và cột thủ công trước khi chạy code

thufpts · 14/3/17

HieuCD đã viết:
đối với dòng phải biết bạn ẩn bằng cách nào mới làm được
tốt nhất bạn bỏ ẩn dòng và cột thủ công trước khi chạy code

Em cũng làm như bác nói mỗi khi chạy là em bỏ hết lọc đi. Nhưng nhiều khi em quên em ko bỏ lọc và ẩn em chạy nó bị nhầm hết dữ liệu. vậy là em lại phải làm bằng tay lại
từ đầu phát ốm. bây giờ em chỉ muốn bác giúp em check điều kiện nếu như có cột ẩn và các dòng bị lọc thì cảnh báo và không chạy code nữa. cho đến kho thỏa mãn điều kiện thì code được chạy.

HieuCD · 14/3/17

thufpts đã viết:
Em cũng làm như bác nói mỗi khi chạy là em bỏ hết lọc đi. Nhưng nhiều khi em quên em ko bỏ lọc và ẩn em chạy nó bị nhầm hết dữ liệu. vậy là em lại phải làm bằng tay lại
từ đầu phát ốm. bây giờ em chỉ muốn bác giúp em check điều kiện nếu như có cột ẩn và các dòng bị lọc thì cảnh báo và không chạy code nữa. cho đến kho thỏa mãn điều kiện thì code được chạy.

bạn thêm đoạn code màu đỏ vào đầu code xem sao

Mã:

Sub GPE()
Dim DR As Range, Rng As Range, Dic As Object, Dic35 As Object, Dic95 As Object
Dim Sarr(), S_UX(), UXarr(), i As Long, R As Long, LastR As Long, Tmp As String
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
Set Dic35 = CreateObject("Scripting.Dictionary")
Set Dic95 = CreateObject("Scripting.Dictionary")
[COLOR=#ff0000]Sheets("DATA"[/COLOR][COLOR=#ff0000]).Rows.Hidden = False
Sheets("DATA").Columns.Hidden = False
Sheets("DATA").AutoFilterMode = False
Sheets("CONTROLLER").Rows.Hidden = False
Sheets("CONTROLLER").Columns.[/COLOR][COLOR=#ff0000]Hidden = False[/COLOR]
[COLOR=#ff0000]Sheets("CONTROLLER").AutoFilterMode = False[/COLOR]
R = Sheets("DATA").Range("A65500").End(xlUp).Row
......

befaint · 14/3/17

Anh HieuCD,

Có thể viết gọn lại như vầy:

Mã:

'Hủy dòng ẩn:
.Rows.Hidden = False
'Hủy cột ẩn:
.Columns.Hidden = False
'Hiện dòng bị lọc (=Clear Filter)
.ShowAllData

HieuCD · 14/3/17

befaint đã viết:
Anh HieuCD,
Có thể viết gọn lại như vầy:

Mã:

'Hủy dòng ẩn: .Rows.Hidden = False 'Hủy cột ẩn: .Columns.Hidden = False 'Hiện dòng bị lọc (=Clear Filter) .ShowAllData

cám ơn bạn, 2 lệnh đầu chạy tốt, riêng .ShowAllData nếu đã showall rồi, showall lần kế sẽ bị lổi

thufpts · 15/3/17

HieuCD đã viết:

bạn thêm đoạn code màu đỏ vào đầu code xem sao

Mã:

Sub GPE()
Dim DR As Range, Rng As Range, Dic As Object, Dic35 As Object, Dic95 As Object
Dim Sarr(), S_UX(), UXarr(), i As Long, R As Long, LastR As Long, Tmp As String
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
Set Dic35 = CreateObject("Scripting.Dictionary")
Set Dic95 = CreateObject("Scripting.Dictionary")
[COLOR=#ff0000]Sheets("DATA"[/COLOR][COLOR=#ff0000]).Rows.Hidden = False
Sheets("DATA").Columns.Hidden = False
Sheets("DATA").AutoFilterMode = False
Sheets("CONTROLLER").Rows.Hidden = False
Sheets("CONTROLLER").Columns.[/COLOR][COLOR=#ff0000]Hidden = False[/COLOR]
[COLOR=#ff0000]Sheets("CONTROLLER").AutoFilterMode = False[/COLOR]
R = Sheets("DATA").Range("A65500").End(xlUp).Row
......

Tuy nó có chậm hơn trước 1 chút thôi nhưng nó đảm bảo chính xác bác ạ.cám ơn bác cám ơn các bác rất nhiều.

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

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

thufpts

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

File đính kèm

HieuCD

Chuyên gia GPE

thufpts

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

HieuCD

Chuyên gia GPE

thufpts

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

thufpts

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

HieuCD

Chuyên gia GPE

thufpts

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

thufpts

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

HieuCD

Chuyên gia GPE

thufpts

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

HieuCD

Chuyên gia GPE

befaint

|||||||||||||

HieuCD

Chuyên gia GPE

thufpts

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

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

Đếm ngược thời gian