Страницы: 1
RSS
Ускорение Макроса автоматической вставки Даты
 
Доброе утро всем!
Хочется ускорить макрос, который при изменению значения определенного столбца устанавливает в соседние текущую дату и имя пользователя компьютера:
Код
Sub DateName(Target As Range, KeyCells As Range)
    If Not Application.Intersect(KeyCells, Target) Is Nothing Then
        Target.Offset(0, 2).Value = Date
        Target.Offset(0, 3).Value = Application.UserName
        Target.Offset(0, 4).Value = Time
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
'столбец куда вносятся изменения
    Col_tag = Range("A1:AM5").Find("STATUS", , xlValues, xlWhole).Column
'столбец куда "вставляется" имя пользователя, чтобы потом его поменять
    Col_Sig = Range("A1:AM5").Find("Signature", , xlValues, xlWhole).Column
    lLastRow = Cells(Rows.Count, Col_tag).End(xlUp).Row
'при изменении столбца Col_tag, записываем дату, имя пользователя и время 
    DateName Target, Range(Cells(5, Col_tag), Cells(lLastRow, Col_tag))
'далее, для удобства идет переименование "имени пользователя" в реальное имя сотрудника
'для примера две замены, по факту их более 20
Range(Cells(5, Col_Sig), Cells(lLastRow, Col_Sig)).Replace What:="PC_USER1", Replacement:="IVAN IVANOV", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False
Range(Cells(5, Col_Sig), Cells(lLastRow, Col_Sig)).Replace What:="PC_USER2", Replacement:="PETR PETROV", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False

В общем код работает отлично, но на одну замены уходит до 1 секунды
Можно ли его переделать, чтобы работал быстрее?
 
Для начала отключите события, он у Вас зацикливается во время замены. А если много формул на листе то еще и пересчет.
Я сам - дурнее всякого примера! ...
 
Убраны были все события:
Код
Sub Workbook_SheetChang
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
Application.Interactive = False
Application.ShowWindowsInTaskbar = False

****

end Sub

не помогает :(
Изменено: slesarok - 10.02.2019 16:42:06
 
Насколько знаю, Find медленый. И меньше работать с объектам листа- загрузить в массив, обработать, выгрузить на лист.
Внести только 1-2 значения? Странно, что при этом тормозит. Покажите файл-пример
 
Цитата
slesarok написал:
'далее, для удобства идет переименование "имени пользователя" в реальное имя сотрудника'для примера две замены, по факту их более 20
ну 20 раз делать замену вместо один раз найти и один раз заменить наверно не дело.
По вопросам из тем форума, личку не читаю.
 
Доброе утро!
Файл во вложении
 
А в макросе ли дело?
замените на листе Daly_Report столбцы на фиксированные диапазоны.
=COUNTIFS('IEC-61850'!$W$1:$W$200;"="&A2;'IEC-61850'!$U$1:$U$200;"PASS")+COUNTIFS('IEC-61850'!$W$1:$W$200;"="&A2;'IEC-61850'!$U$1:$U$200;"NOT USE")
Сразу заметите разницу.
Изменено: БМВ - 11.02.2019 09:34:04
По вопросам из тем форума, личку не читаю.
 
Спасибо большое, действительно летает теперь)))
Страницы: 1
Наверх