Тем у кого нет power query
Таблица находится на Лист_1
Таблица находится на Лист_1
Код |
---|
Sub Limits() Dim FoundLimit As Range Dim FirstAdr As String Dim BeginDiapazon As Long Dim EndDiapazon As Long Dim iLastRow As Long Dim iLastRow_1 As Long Dim j As Integer Dim limitNomer As Long With ThisWorkbook.Worksheets("Лист_1") iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row .Range("G2:M" & iLastRow).ClearContents ' очищаем iLastRow_1 = .Cells(.Rows.Count, "G").End(xlUp).Row + 1 Set FoundLimit = .Columns("A").Find("Лимиты", , xlValues, xlWhole) If Not FoundLimit Is Nothing Then FirstAdr = FoundLimit.Address 'адрес первого вхождения Do limitNomer = FoundLimit.Offset(-1) BeginDiapazon = FoundLimit.Row + 1 Set FoundLimit = .Columns("A").Find("Лимиты", After:=FoundLimit) If FoundLimit.Address <> FirstAdr Then EndDiapazon = FoundLimit.Row - 1 Else EndDiapazon = iLastRow End If For j = BeginDiapazon To EndDiapazon ' цикл по диапазону наименований If IsDate(Cells(j, 1)) Then .Cells(iLastRow_1, "G") = Int(.Cells(j, 1)) ' .Cells(iLastRow_1, "H") = .Cells(j, 1) - Int(.Cells(j, 1)) .Cells(iLastRow_1, "I") = .Cells(j, 2) .Cells(iLastRow_1, "J") = .Cells(j, 3) .Cells(iLastRow_1, "K") = .Cells(j, 4) .Cells(iLastRow_1, "L") = .Cells(j, 5) ' .Cells(iLastRow_1, "M") = limitNomer ' iLastRow_1 = iLastRow_1 + 1 End If Next Loop While FoundLimit.Address <> FirstAdr End If End With End Sub |