Nhờ các bạn/Anh/Chị cải thiện tốc độ vòng lặp For (2 người xem)

[thinh.cao]

Chào các bạn/anh/chị,

Đoạn code bên dưới mấy hôm trước mình sử dụng thì chạy hết khoảng 1 phút. nhưng hôm nay mất gần 30 phút nhưng không hiểu tại sao. nhờ các cao thủ vui lòng giúp sức.

Phần code này hôm trước có nhờ ndu96081631 và một số bạn khác giúp sức ở những đoạn chính yếu.

Sub Convert_sort()


Dim dc_open As Double
Dim xoa_sum As Double
Dim dc_code As Double
Dim i As Double
Dim tb As String

dc_code = Sheets("Open item").Range("C10000").End(xlUp).Row
xoa_sum = Sheets("Open item").Range("Q10000").End(xlUp).Row
dc_open = Sheets("Open item").Range("O10000").End(xlUp).Row


' lam sao de cai thien toc do vong lap?
If xoa_sum > dc_open Then

For i = 9 To dc_open
If Cells(i, 15) <> 0 Then
Cells(i, 24).Value = DateSerial(Right(Cells(i, 15).Value, 4), _
Mid(Cells(i, 15).Value, 4, 2), Left(Cells(i, 15).Value, 2))
End If
Next

Range("X9:X" & dc_open).Copy Range("O9:O" & dc_open)
Application.CutCopyMode = False

Rows(xoa_sum).Select
Selection.ClearContents

Rows("9:" & dc_code).Select
ActiveWorkbook.Worksheets("Open item").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Open item").Sort.SortFields.Add Key:=Range( _
"O9:O" & dc_code), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Open item").Sort.SortFields.Add Key:=Range( _
"D9" & dc_code), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Open item").Sort.SortFields.Add Key:=Range( _
"C9:C" & dc_code), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Open item").Sort
.SetRange Range("A9:AC" & dc_code)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


'/ Them ten vao tieu de
Range("X7") = "Ref"

'/ Hide comlums
Columns("Y:XFD").Select
Selection.EntireColumn.Hidden = True
Columns("E:J").Select
Selection.EntireColumn.Hidden = True
Columns("L:L").Select
Selection.EntireColumn.Hidden = True
Columns("N:N").Select
Selection.EntireColumn.Hidden = True
Columns("T:W").Select
Selection.EntireColumn.Hidden = True

'/ To mau tieu de
Range("C7:U7").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With

'/ To mau cot X
Range("X7:X" & dc_code).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Selection.Font.Italic = True

'/ Fit do rong cot
Columns("C").EntireColumn.AutoFit
Columns("K").EntireColumn.AutoFit
Columns("X").EntireColumn.AutoFit
Columns("M").EntireColumn.AutoFit
Columns("O:S").EntireColumn.AutoFit
Range("D9").Select

tb = "Convert & sort success" & vbNewLine
tb = tb & "Move to Aging sheet"
MsgBox (tb)

'/ Chuyen den sheet Aging & auto filter

Worksheets("AGING").Activate
ActiveSheet.ShowAllData
ActiveSheet.Range("$A$11:$W$500").AutoFilter Field:=10, Criteria1:=">0", _
Operator:=xlAnd
Range("J13").Select

Else
MsgBox ("No need")
ActiveSheet.ShowAllData
ActiveSheet.Range("$A$11:$W$500").AutoFilter Field:=10, Criteria1:=">0", _
Operator:=xlAnd
Range("J13").Select

End If

End Sub

Cảm ơn nhiều,
Thinh.cao