Здравствуйте друзья!
У меня имеется макрос, который был великодушно написан мне пользователем SAS888, за что огромное спасибо ему.
Вот он:
Код |
---|
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
|
Работает превосходно! Но обрабатывает данные до строки не весь отчёт, а дальше все верх дном. Помогите пожалуйста сделать этот макрос работающим до конца сколько бы не было.
Спасибо большое за Ваше внимание!