Страницы: 1
RSS
Перенести обработку диапазонов из прямого обращения в обработку в памяти
 
Доброе утро. Коллеги, опубликую здесь ранее выложенное в платном разделе. Как-то там очень скучно, было только одно предложение, странное по срокам и стоимости для несложной задачи. Здесь упрощу, спрошу только по одному макросу, подхвачу суть и метод и дальше буду решать сам. Есть макрос в файле (вложение и код ниже) - его суть собирать данные с матричной таблицы листа 1, проверяя при этом только непустые значения, в плоскую таблицу листа 2 с проверкой есть ли уже такая строка по ключу user_name,date_, direction, process. Если она есть  - записать поверх, с новым временем. Если такой строки нет, добавить данные вниз диапазона.
Проблема в том, что он написан не очень эффективно на циклах и ячейках листа, прошу помочь перенести его на обработку в памяти, на массивах или через словарь.
Код
Sub In_Base()
'основные задачи
For i = 12 To 36
For j = 3 To 33
lLastRow = Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row
For N = 2 To lLastRow
If Cells(i, j) <> "" And Cells(i, 1) <> "" Then
If Sheets("TR").Range("B6").Value & Sheets("TR").Cells(i, 1).Value & Sheets("TR").Cells(11, j).Value = Sheets("BASE").Cells(N, 4).Value & Sheets("BASE").Cells(N, 5).Value & Sheets("BASE").Cells(N, 3).Value Then
Sheets("BASE").Cells(N, 1) = Sheets("TR").Cells(1, 2)
Sheets("BASE").Cells(N, 2) = Sheets("TR").Cells(2, 2)
Sheets("BASE").Cells(N, 3) = Sheets("TR").Cells(11, j)
Sheets("BASE").Cells(N, 4) = Sheets("TR").Cells(6, 2)
Sheets("BASE").Cells(N, 5) = Sheets("TR").Cells(i, 1)
Sheets("BASE").Cells(N, 6) = Sheets("TR").Cells(i, j)
End If

If Sheets("TR").Range("B6").Value & Sheets("TR").Cells(i, 1).Value & Sheets("TR").Cells(11, j).Value <> Sheets("BASE").Cells(N, 4).Value & Sheets("BASE").Cells(N, 5).Value & Sheets("BASE").Cells(N, 3).Value Then
Sheets("BASE").Cells(lLastRow + 1, 1) = Sheets("TR").Cells(1, 2)
Sheets("BASE").Cells(lLastRow + 1, 2) = Sheets("TR").Cells(2, 2)
Sheets("BASE").Cells(lLastRow + 1, 3) = Sheets("TR").Cells(11, j)
Sheets("BASE").Cells(lLastRow + 1, 4) = Sheets("TR").Cells(6, 2)
Sheets("BASE").Cells(lLastRow + 1, 5) = Sheets("TR").Cells(i, 1)
Sheets("BASE").Cells(lLastRow + 1, 6) = Sheets("TR").Cells(i, j)
End If
End If
Next
Next
Next
'обед
For j = 3 To 33
If Cells(38, j) <> "" Then
lLastRow = Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("BASE").Cells(lLastRow + 1, 1) = Sheets("TR").Cells(1, 2)
Sheets("BASE").Cells(lLastRow + 1, 2) = Sheets("TR").Cells(2, 2)
Sheets("BASE").Cells(lLastRow + 1, 3) = Sheets("TR").Cells(11, j)
Sheets("BASE").Cells(lLastRow + 1, 4) = "Прочее и доп задачи"
Sheets("BASE").Cells(lLastRow + 1, 5) = Sheets("TR").Cells(38, 2)
Sheets("BASE").Cells(lLastRow + 1, 6) = Sheets("TR").Cells(38, j)
End If
Next
'дополнительные задачи
For i = 43 To 78
For j = 3 To 33
lLastRow = Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row
For N = 2 To lLastRow
If Cells(i, j) <> "" And Cells(i, 2) <> "" Then
If "Прочее и доп задачи" & Sheets("TR").Cells(i, 2).Value & Sheets("TR").Cells(11, j).Value = Sheets("BASE").Cells(N, 4).Value & Sheets("BASE").Cells(N, 5).Value & Sheets("BASE").Cells(N, 3).Value Then
Sheets("BASE").Cells(N, 1) = Sheets("TR").Cells(1, 2)
Sheets("BASE").Cells(N, 2) = Sheets("TR").Cells(2, 2)
Sheets("BASE").Cells(N, 3) = Sheets("TR").Cells(11, j)
Sheets("BASE").Cells(N, 4) = "Прочее и доп задачи"
Sheets("BASE").Cells(N, 5) = Sheets("TR").Cells(i, 2)
Sheets("BASE").Cells(N, 6) = Sheets("TR").Cells(i, j)
End If
If "Прочее и доп задачи" & Sheets("TR").Cells(i, 2).Value & Sheets("TR").Cells(11, j).Value <> Sheets("BASE").Cells(N, 4).Value & Sheets("BASE").Cells(N, 5).Value & Sheets("BASE").Cells(N, 3).Value Then
lLastRow = Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("BASE").Cells(lLastRow + 1, 1) = Sheets("TR").Cells(1, 2)
Sheets("BASE").Cells(lLastRow + 1, 2) = Sheets("TR").Cells(2, 2)
Sheets("BASE").Cells(lLastRow + 1, 3) = Sheets("TR").Cells(11, j)
Sheets("BASE").Cells(lLastRow + 1, 4) = "Прочее и доп задачи"
Sheets("BASE").Cells(lLastRow + 1, 5) = Sheets("TR").Cells(i, 2)
Sheets("BASE").Cells(lLastRow + 1, 6) = Sheets("TR").Cells(i, j)
End If
End If
Next
Next
Next
lLastRow = Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("BASE").Columns("C:C").NumberFormat = "m/d/yyyy"
Sheets("BASE").Range("$A$1:$F$" & lLastRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes
Sheets("TR").Range("C12:AG36").ClearContents
    lLastRow = Sheets("BASE").Cells(Rows.Count, 1).End(xlUp).Row
    For i = lLastRow To 2 Step -1
    If Not IsNumeric(Sheets("BASE").Cells(i, 6).Value) Or Sheets("BASE").Cells(i, 6).Value = "" Then
    Sheets("BASE").Rows(i).Delete
    End If
    Next
End Sub
 
Цитата
IVIVV написал: ранее выложенное в платном разделе.
Так пусть автор и 'допилит'
Согласие есть продукт при полном непротивлении сторон
 
Или сами, раз
Цитата
IVIVV написал: подхвачу суть и метод и дальше буду решать сам...
...на массивах или через словарь...
Массивы в VBA
Описание объекта Dictionary
Согласие есть продукт при полном непротивлении сторон
Страницы: 1
Наверх