Всех приветствую!
Есть таблица выгрузки по ключам в которой по очереди идёт вход и выход (различные дубли уже убираются, по этому более-менее чисто).
Есть только когда человек вошел не вышел, или вышел не вошел (обычно такое у суточников).
В общем макрос ориентируясь по совпадению фамилии в столбце А проверяет наличие слова "Выход" и переносит его на одну строку ко "Входу".
Таким образом на одной строке дата и время входа и дата и время выхода.
Массив за месяц около 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
|
