Truy xuất dữ liệu trùng

Liên hệ QC

hvphong

Thành viên chính thức
Tham gia
28/9/07
Bài viết
56
Được thích
1
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.@$@!^%
 
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!
 
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.
 

File đính kèm

  • loc trung.rar
    26 KB · Đọc: 38
Lần chỉnh sửa cuối:
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.
 
Lần chỉnh sửa cuối:
Cách của bạn hay quá. Bạn chỉ mình nhé!
Thanks nha
 
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
PHP:
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 đính kèm

  • loc trung2222.rar
    35 KB · Đọc: 53
CÁI NÀY MỚI NHANH HƠN NÈ CODE GPE ĐẤY
PHP:
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
 
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:
Mã:
[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:
Mã:
[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ỗ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:
Mã:
[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:
Mã:
[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
 
Lần chỉnh sửa cuối:
Web KT
Back
Top Bottom