Truy xuất dữ liệu trùng (2 người xem)

[hvphong]

Mình cần lấy một số trong nhóm số bị trùng sang cột khác. cách tính của mình bấy lâu nay rời rác quá lại tốn nhiều thời gian.

 

[Luc Van]

Mình cần lấy một số trong nhóm số bị trùng sang cột khác. cách tính của mình bấy lâu nay rời rác quá lại tốn nhiều thời gian.

Cụ thể là như thế nào? Bạn gửi file lên đây. và cách tính của bạn trước kia như thế nào? Để mọi người còn giúp được bạn chứ biết đâu giúp bạn cách lại trùng với cách bạn đang làm thì tốn thời gian của bạn và mọi người quá.
Thân!

 

[hvphong]

mình gủi lên ngay đây

vì mới tham gia diển đàn nên chưa thành thuc lắm, chu hôm qua có đính kèm file mà không biết là gủi không đươcl.

 

[Bani1308]

Theo mình thấy bạn làm như vậy cũng được mà, bạn chì làm thêm bước nữa là dán đặc biệt cột công thức, sau đó bạn sort thôi là ok.

Hoặc tại ô B5 bạn dùng hàm if(countif($A$5:A5,A5)>1,"",A5), sau đó bạn dán đặc biệt cột công thức, rồi sort thôi là ok.

 

[hanhpptc]

Mình cần lấy một số trong nhóm số bị trùng sang cột khác. cách tính của mình bấy lâu nay rời rác quá lại tốn nhiều thời gian.

Bạn xem File đính kèm xem có đúng ý của bạn không

 

[Bani1308]

Cách của bạn hay quá. Bạn chỉ mình nhé!
Thanks nha

 

[Lê Duy Thương]

Thêm file

Cách của bạn hay quá. Bạn chỉ mình nhé!
Thanks nha

CÁI NÀY MỚI NHANH HƠN NÈ CODE GPE ĐẤY

Sub NHANHHON()
With Application
.Calculation = False
.ScreenUpdating = False

Sheets("TEST").Range("D6:D65536").ClearContents

  Dim clls As Range, dic, i As Long
  Set dic = CreateObject("Scripting.Dictionary")
  For Each clls In Range("A6:A" & [A65536].End(xlUp).Row)
    clls.Select
    If Not dic.Exists(clls.Value) Then
      dic.Add clls.Value, ""
      i = i + 1
      Cells(i + 4, "D") = clls.Value
    Else
    
    End If
  Next
  .Calculation = xlAutomatic
  End With
End Sub

 

[thuytieu]

CÁI NÀY MỚI NHANH HƠN NÈ CODE GPE ĐẤY

Sub NHANHHON()
With Application
.Calculation = False
.ScreenUpdating = False

Sheets("TEST").Range("D6:D65536").ClearContents

  Dim clls As Range, dic, i As Long
  Set dic = CreateObject("Scripting.Dictionary")
  For Each clls In Range("A6:A" & [A65536].End(xlUp).Row)
    clls.Select
    If Not dic.Exists(clls.Value) Then
      dic.Add clls.Value, ""
      i = i + 1
      Cells(i + 4, "D") = clls.Value
    Else
    
    End If
  Next
  .Calculation = xlAutomatic
  End With
End Sub

File bị lỗi mà bạn ơi

 

[Lê Duy Thương]

File bị lỗi mà bạn ơi

tôi đã test chạy rất ngon lành
bạn thử đưa hình lỗi lên xem nhé

 

[concogia]

tôi đã test chạy rất ngon lành
bạn thử đưa hình lỗi lên xem nhé

Lỗi ở .Calculation = False
Nhưng sao đã "chơi" em "Đít to" mà còn xử lý trực tiếp lên Cells nhỉ???
Thử cái này:

[COLOR=#0000bb][COLOR=#0000bb]Public Sub xx()[/COLOR]
[COLOR=#0000bb] Dim dic, I As Long, Tg, Vung[/COLOR]
[COLOR=#0000bb] Tg = Timer[/COLOR]
[COLOR=#0000bb]     Vung = Range([a5], [a50000].End(xlUp)).Value[/COLOR]
[COLOR=#0000bb]     Set dic = CreateObject("Scripting.Dictionary")[/COLOR]
[COLOR=#0000bb]         For I = 1 To UBound(Vung)[/COLOR]
[COLOR=#0000bb]             If Not dic.Exists(Vung(I, 1)) Then[/COLOR]
[COLOR=#0000bb]                 dic.Add Vung(I, 1), ""[/COLOR]
[COLOR=#0000bb]             End If[/COLOR]
[COLOR=#0000bb]         Next[/COLOR]
[COLOR=#0000bb] [c5].Resize(dic.Count) = Application.WorksheetFunction.Transpose(dic.keys)[/COLOR]
[COLOR=#0000bb]MsgBox "Tg: " & Timer - Tg[/COLOR]
[COLOR=#0000bb]End Sub[/COLOR]
[/COLOR]

và cái này nữa:

[COLOR=#0000bb]Public Sub aa()[/COLOR]
[COLOR=#0000bb]  Dim Loc As New Collection, Cll, I, K, Mg(), Vung, Tg As Double[/COLOR]
[COLOR=#0000bb]  Tg = Timer[/COLOR]
[COLOR=#0000bb]  On Error Resume Next[/COLOR]
[COLOR=#0000bb]      Vung = Range([a5], [a65000].End(xlUp)).Value[/COLOR]
[COLOR=#0000bb]      K = 1[/COLOR]
[COLOR=#0000bb]          For I = 1 To UBound(Vung)[/COLOR]
[COLOR=#0000bb]              Loc.Add Vung(I, 1), CStr(Vung(I, 1))[/COLOR]
[COLOR=#0000bb]          Next I[/COLOR]
[COLOR=#0000bb]              ReDim Mg(1 To Loc.Count, 1 To 1)[/COLOR]
[COLOR=#0000bb]                  For I = 1 To Loc.Count[/COLOR]
[COLOR=#0000bb]                      Mg(I, 1) = Loc(I)[/COLOR]
[COLOR=#0000bb]                  Next[/COLOR]
[COLOR=#0000bb]  [e5].Resize(Loc.Count) = Mg[/COLOR]
[COLOR=#0000bb]  MsgBox "Tg: " & Timer - Tg[/COLOR]
[COLOR=#0000bb]End Sub[/COLOR]

Bạn xem tốc độ nó như thế nào

 

[Lê Duy Thương]

Lỗi ở .Calculation = False
Nhưng sao đã "chơi" em "Đít to" mà còn xử lý trực tiếp lên Cells nhỉ???
Thử cái này:

[COLOR=#0000bb][COLOR=#0000bb]Public Sub xx()[/COLOR]
[COLOR=#0000bb] Dim dic, I As Long, Tg, Vung[/COLOR]
[COLOR=#0000bb] Tg = Timer[/COLOR]
[COLOR=#0000bb]     Vung = Range([a5], [a50000].End(xlUp)).Value[/COLOR]
[COLOR=#0000bb]     Set dic = CreateObject("Scripting.Dictionary")[/COLOR]
[COLOR=#0000bb]         For I = 1 To UBound(Vung)[/COLOR]
[COLOR=#0000bb]             If Not dic.Exists(Vung(I, 1)) Then[/COLOR]
[COLOR=#0000bb]                 dic.Add Vung(I, 1), ""[/COLOR]
[COLOR=#0000bb]             End If[/COLOR]
[COLOR=#0000bb]         Next[/COLOR]
[COLOR=#0000bb] [c5].Resize(dic.Count) = Application.WorksheetFunction.Transpose(dic.keys)[/COLOR]
[COLOR=#0000bb]MsgBox "Tg: " & Timer - Tg [/COLOR]
[COLOR=#0000bb]End Sub
[/COLOR][/COLOR][B][SIZE=3][COLOR=#0000bb][COLOR=#0000bb]'([COLOR=red]tại sao đoạn code này khi dữ liệu càng nhiều thì chạy càng nhanh nhỉ ? mong các bác giải thích)[/COLOR][/COLOR][/COLOR][/SIZE][/B]

và cái này nữa:

[COLOR=#0000bb]Public Sub aa()[/COLOR]
[COLOR=#0000bb]  Dim Loc As New Collection, Cll, I, K, Mg(), Vung, Tg As Double[/COLOR]
[COLOR=#0000bb]  Tg = Timer[/COLOR]
[COLOR=#0000bb]  On Error Resume Next[/COLOR]
[COLOR=#0000bb]      Vung = Range([a5], [a65000].End(xlUp)).Value[/COLOR]
[COLOR=#0000bb]      K = 1[/COLOR]
[COLOR=#0000bb]          For I = 1 To UBound(Vung)[/COLOR]
[COLOR=#0000bb]              Loc.Add Vung(I, 1), CStr(Vung(I, 1))[/COLOR]
[COLOR=#0000bb]          Next I[/COLOR]
[COLOR=#0000bb]              ReDim Mg(1 To Loc.Count, 1 To 1)[/COLOR]
[COLOR=#0000bb]                  For I = 1 To Loc.Count[/COLOR]
[COLOR=#0000bb]                      Mg(I, 1) = Loc(I)[/COLOR]
[COLOR=#0000bb]                  Next[/COLOR]
[COLOR=#0000bb]  [e5].Resize(Loc.Count) = Mg[/COLOR]
[COLOR=#0000bb]  MsgBox "Tg: " & Timer - Tg[/COLOR]
[COLOR=#0000bb]End Sub[/COLOR]

Bạn xem tốc độ nó như thế nào

code cực nhanh
do tôi đang nghiên cứu dictionary nên chưa thể dùng mảng được. xử lý trực tiếp trên cells mà còn vả mồ hôi đấy bác ạ
hì bác cò già chơi xấu. dùng cả newcolection nữa chứ