Направляю файл эксель. Нужно после каждой ячейки "01.12.2023" добавить 12 строк, которые содержали бы 12 значений 01.01.2024, 01.02.2024, 01.03.2024, ..., 01.12.2024 (в том же формате, янв.24)
Таких арендаторов много, поэтому руками это сделать трудоемко. Подскажите, пожалуйста, есть ли способ сделать макрос, который бы находил уникальное значение "01.12.2023" и после этого делал указанные выше действия?
Добрый день.
Направляю файл эксель. Нужно после каждой ячейки "01.12.2023" добавить 12 строк, которые содержали бы 12 значений 01.01.2024, 01.02.2024, 01.03.2024, ..., 01.12.2024 (в том же формате, янв.24)
Таких арендаторов много, поэтому руками это сделать трудоемко. Подскажите, пожалуйста, есть ли способ сделать макрос, который бы находил уникальное значение "01.12.2023" и после этого делал указанные выше действия?Spirtuoz
Sub io() Dim i As Long Dim arr(1 To 12, 1 To 1) As Date
For i = 1 To 12 'генерация массива дат arr(i, 1) = DateSerial(2023, 12 + i, 1) Next i
'вставка в обратном цикле, чтобы не пересчитывать позиции For i = 39 To 13 Step -13 Cells(i, 1).Offset(1).Resize(12).Insert Shift:=xlDown, CopyOrigin:=Cells(i, 1) Cells(i, 1).Offset(1).Resize(12).Value = arr Next i End Sub
Sub io() Dim i As Long Dim arr(1 To 12, 1 To 1) As Date
For i = 1 To 12 'генерация массива дат arr(i, 1) = DateSerial(2023, 12 + i, 1) Next i
'вставка в обратном цикле, чтобы не пересчитывать позиции For i = 39 To 13 Step -13 Cells(i, 1).Offset(1).Resize(12).Insert Shift:=xlDown, CopyOrigin:=Cells(i, 1) Cells(i, 1).Offset(1).Resize(12).Value = arr Next i End Sub
Sub u_541() Application.ScreenUpdating = False For u = 1 To 12 a = Cells(Rows.Count, "a").End(xlUp).Row Range("a1:a" & a).SpecialCells(xlCellTypeConstants, 2).Insert Shift:=xlDown, _ CopyOrigin:=xlFormatFromLeftOrAbove Next Range("a1:a12").Delete Shift:=xlUp Range("a1:a" & a - 12).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = _ "=DATE(YEAR(R[-12]C)+1,MONTH(R[-12]C),1)" Range("a1:a" & a - 12) = Range("a1:a" & a - 12).Value Application.ScreenUpdating = True End Sub
[/vba]
так смешнее [vba]
Код
Sub u_541() Application.ScreenUpdating = False For u = 1 To 12 a = Cells(Rows.Count, "a").End(xlUp).Row Range("a1:a" & a).SpecialCells(xlCellTypeConstants, 2).Insert Shift:=xlDown, _ CopyOrigin:=xlFormatFromLeftOrAbove Next Range("a1:a12").Delete Shift:=xlUp Range("a1:a" & a - 12).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = _ "=DATE(YEAR(R[-12]C)+1,MONTH(R[-12]C),1)" Range("a1:a" & a - 12) = Range("a1:a" & a - 12).Value Application.ScreenUpdating = True End Sub