Всех приветствую!
Есть таблица выгрузки по ключам в которой по очереди идёт вход и выход (различные дубли уже убираются, по этому более-менее чисто).
Есть только когда человек вошел не вышел, или вышел не вошел (обычно такое у суточников).
В общем макрос ориентируясь по совпадению фамилии в столбце А проверяет наличие слова "Выход" и переносит его на одну строку ко "Входу".
Таким образом на одной строке дата и время входа и дата и время выхода.
Массив за месяц около 50 тыс. строк. Написал небольшой макрос который сам переносит диапазон по заданным условиям.
Есть проблема, что похоже офисному компу это сложно вытянуть и процедура просто зависает, домашний комп справляется нормально.
Может подскажите возможный вариант оптимизации?
Я так понимаю что дается трудно момент вырезки и вставки.
Есть таблица выгрузки по ключам в которой по очереди идёт вход и выход (различные дубли уже убираются, по этому более-менее чисто).
Есть только когда человек вошел не вышел, или вышел не вошел (обычно такое у суточников).
В общем макрос ориентируясь по совпадению фамилии в столбце А проверяет наличие слова "Выход" и переносит его на одну строку ко "Входу".
Таким образом на одной строке дата и время входа и дата и время выхода.
Массив за месяц около 50 тыс. строк. Написал небольшой макрос который сам переносит диапазон по заданным условиям.
Есть проблема, что похоже офисному компу это сложно вытянуть и процедура просто зависает, домашний комп справляется нормально.
Может подскажите возможный вариант оптимизации?
Я так понимаю что дается трудно момент вырезки и вставки.
Код |
---|
Sub Копирование() Dim V As String V = 2 While Range("A" & V).Value <> "" If Range("A" & V) = Range("A" & V - 1) Then If Range("D" & V) = "Выход" Then Application.CutCopyMode = False Range("B" & V, "E" & V).Cut Destination:=Range("G" & V - 1, "J" & V - 1) Range("K" & V - 1) = "Формула" Range("L" & V - 1) = "Формула2" End If Else If Range("D" & V) = "Выход" Then Application.CutCopyMode = False Range("B" & V, "E" & V).Cut Destination:=Range("G" & V, "J" & V) Range("K" & V) = "Формула" Range("L" & V) = "Формула2" End If End If V = V + 1 Wend End Sub |