Страницы: 1
RSS
Перенос ячеек (VBA): группировка входов и выходов работника
 
Всех приветствую!
Есть таблица выгрузки по ключам в которой по очереди идёт вход и выход (различные дубли уже убираются, по этому более-менее чисто).
Есть только когда человек вошел не вышел, или вышел не вошел (обычно такое у суточников).
В общем макрос ориентируясь по совпадению фамилии в столбце А проверяет наличие слова "Выход" и переносит его на одну строку ко "Входу".
Таким образом на одной строке дата и время входа и дата и время выхода.
Массив за месяц около 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
 
Цитата
Spaunrus написал:
Массив за месяц около 50 тыс. строк.
Домашний комп справляется нормально.
А если производство расширится и количество "суточников" вырастет?  :)
Ваш макрос, однозначно, и даже в домашнем компе "прикажет долго жить"!
Грузите исходную информацию в оперативную память компьютера и стройте отдельную таблицу-протокол, для которой не надо ничего Вырезать и Вставлять.
Ваш макрос будет "мухой летать"!  :D
Где файл?
 
Прикладываю пример файлика.
 
Загрузить всё в массив и работать с ним, потом вставить его на страницу
 
kavaka08, можно поподробней? :)
 
Примитивно, но работает.   ;)
P.S.
"Cуточники" в Протоколе выделены цветом.
Изменено: Мотя - 20.06.2017 05:47:59
 
Мотя, спасибо за интерес к проблеме!)
Но получилось не совсем то, конечный вариант ожидается таким, прикладываю.
 
У меня реализован похожий файл, только нет колонки "Зона". Я выносил ячейки с "выходом" правее ячеек со "входом" потом удалить пустые строки, а потом формула типа =ЕСЛИ( ячейка =Выход то Б2-А2 иначе А2-Б2).
Но конечно же лучше
Цитата
kavaka08 написал:
Загрузить всё в массив и работать с ним, потом вставить его на страницу
Я пока не дорос, это работает на костыле, надо другие задачи делать)
 
Дмитрий Тарковский, в приложенном файлике вроде ничего не изменилось :)
 
Ну как же, я расставил выход справа, а вход слева)
Это кусочек кода с моего файла, мне сейчас просто некогда под Ваш файл затачивать макрос. Покажите пару строк исходных данных как они Вам приходят в первоначальном виде, хочется понять с одной системой работаем или нет). Может быть вообще массивами заморочится стоит
Код
With Worksheets("Лист1")
    For i = NumRow To 2 Step -1
        If .Cells(i, 2) = .Cells(i - 1, 2) And .Cells(i, 3) = "Выход" Then .Cells(i - 1, 5) = .Cells(i, 3): .Cells(i - 1, 6) = .Cells(i, 4): .Cells(i, 4).EntireRow.Delete
    Next
End With
 
Дмитрий Тарковский,скидываю
 
Как понял для первой вводной из #3 :
 
С.М.,Получилось очень круто!)
Огромное спасибо, самому такое слабо)
Страницы: 1
Наверх