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]