В поисках повышения скорости работы макроса с циклом и преобразования даты в другой формат

Question

Мой код ниже работает, но он очень медленный ... Фактически этот код состоит в преобразовании даты в столбцах C и D моего листа (называемой «Тест») из формата day.month.year в формат day / month / year (Например, см. Рисунок ниже, строки 1-2-3-4-5 уже преобразованы, тогда как другие строки из строки 1183 еще не были преобразованы).

Я ищу решение, чтобы улучшить скорость этого макроса, потому что если у меня много строк для преобразования в столбцах C и D, макрос действительно очень медленный ...

Если бы случайно кто-то знал, как улучшить скорость этого макроса, это было бы действительно фантастически.

Sub convertdatrighteuropeanformat()
    Dim cell As Range
    Call selectallmylinesctrlshiftdown

    Application.ScreenUpdating = False

    For Each cell In Selection
        With cell
            .NumberFormat = "@"
            .Value = Format(.Value, "dd/mm/yyyy")
        End With
    Next cell

    Selection.Replace What:="/", Replacement:=".", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False

    Application.ScreenUpdating = True
End Sub


Sub selectallmylinesctrlshiftdown()
    With Sheets("Test")
        .Range(.Range("D2"), .Range("E2").End(xlDown)).Select
    End With
End Sub

Answer 1

Вместо цикла, обращайтесь ко всему Range (ранее Selection) сразу внутри блока With. Это объединено в одну подпрограмму, хотя в вашем решении объявить диапазон с помощью отдельной процедуры нет ничего плохого.

Option Explicit

Sub convert()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Test")
Dim LRow As Long, MyCell As Range, MyRange As Range

LRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row
Set MyRange = ws.Range("D2:E" & LRow)

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    With MyRange
        .Value = Format(.Value, "dd/mm/yyyy")
        .Replace "/", ".", xlPart, xlByRows
        .NumberFormat = "@"
    End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub