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ôngMì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ÁI NÀY MỚI NHANH HƠN NÈ CODE GPE ĐẤYCách của bạn hay quá. Bạn chỉ mình nhé!
Thanks nha
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 ơiCÁ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
tôi đã test chạy rất ngon lànhFile bị lỗi mà bạn ơi
Lỗi ở .Calculation = Falsetôi đã test chạy rất ngon lành
bạn thử đưa hình lỗi lên xem nhé
[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]
[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]
code cực nhanhLỗ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:
và cái này nữa: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]
Bạn xem tốc độ nó như thế nàoMã:[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]