Макрос для вставки пропущенных дат за определённый период.

[netmaker]

Здравствуйте, дорогие форумчане!
Есть отчет прихода на работу работников, в файле Example или сам собственно и отчёт. Для этого отчёта необходимо написать макрос который бы, вписывал строки с пропущенными датами, учитывая наименьшее и наибольшее число даты. Например, в файле примера наименьшее это 23/05/20018, а наибольшее 28/05/2018. И в определенном периоде все эти даты должны вписаться в отчёт. В файле Example есть два листа. Первый лист показывает то, что имеется в начале. Второй лист показывает то, что хотелось бы получить в результате работы макроса.
Заранее спасибо Вам друзья!!!

[Serge_Bliznykov]

Сообщение от netmaker

Например, в файле примера наименьшее это 23/05/20018

и поэтому Вы первой же строкой на листе "Хочу получить" вставляете 22.05.2018 ?
а почему в листе "Хочу получить" для Name3 начинается c 25.05.2018 ? Там строчки с более ранними датами не нужны?

[netmaker]

22.05.2018 потому что это наименьшая дата в этом отчёте.

[netmaker]

У меня есть макрос:

Sub InsRows()
    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    Dim maDt As Long, miDt As Long, a(), b(), z, q
    Application.ScreenUpdating = False
    Set z = CreateObject("Scripting.Dictionary")
    i = Cells(Rows.Count, 1).End(xlUp).Row
    a = Range("A3:P" & i).Value
    miDt = Application.Min(Range("H3:H" & i))
    maDt = Application.Max(Range("H3:H" & i))
    For i = 1 To UBound(a, 1): z(a(i, 2)) = i: Next
    ReDim b(1 To z.Count * (maDt - miDt + 1), 1 To UBound(a, 2))
    For Each q In z.Items
        For j = miDt To maDt
            k = k + 1
            For m = 1 To 7
                b(k, m) = a(q, m)
                b(k, 8) = j
                For i = 1 To UBound(a, 1)
                    If a(i, 8) = j Then
                        If a(i, 2) = b(k, 2) Then
                            For n = 9 To 16: b(k, n) = a(i, n): Next
                            Exit For
    End If: End If: Next: Next: Next: Next
    [A3].Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Но при выполнении макрос не обрабатывает отчёт.xlsx файл до конца. В связи с чем вопрос в чём причина?


_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

[SAS888]

макрос не обрабатывает отчёт.xlsx файл до конца. В связи с чем вопрос в чём причина?

Причина в том, что данный макрос для определения блока, в который требуется вставить недостающие строки, анализирует столбец "B".
В файле "Example" - три блока. Это "OTDEL 1", "OTDEL 2" и "OTDEL 3", для каждого из которых добавляются строки.
В файле "Отчет" у Вас есть совпадающие блоки. Например, "DOUBLING/TWISTI 2 SHIFT" встречается несколько раз (с различными AC-No.).
Укажите, как однозначно идентифицировать блок, в который требуется добавлять строки. Макрос будет другой.

[netmaker]

Сообщение от SAS888

Причина в том, что данный макрос для определения блока, в который требуется вставить недостающие строки, анализирует столбец "B".
В файле "Example" - три блока. Это "OTDEL 1", "OTDEL 2" и "OTDEL 3", для каждого из которых добавляются строки.
В файле "Отчет" у Вас есть совпадающие блоки. Например, "DOUBLING/TWISTI 2 SHIFT" встречается несколько раз (с различными AC-No.).
Укажите, как однозначно идентифицировать блок, в который требуется добавлять строки. Макрос будет другой.

SAS888, А если вместо "OTDEL 1", "OTDEL 2" и "OTDEL 3" есть скажем 1 отдел?