Добавление пустых строк после значения

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Добавление пустых строк после значения (Макросы/Sub)

Spirtuoz

Дата: Среда, 30.08.2023, 12:09 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 10

Репутация: 0 ±

Замечаний: 0% ±

Добрый день.

Направляю файл эксель. Нужно после каждой ячейки "01.12.2023" добавить 12 строк, которые содержали бы 12 значений 01.01.2024, 01.02.2024, 01.03.2024, ..., 01.12.2024 (в том же формате, янв.24)

Таких арендаторов много, поэтому руками это сделать трудоемко. Подскажите, пожалуйста, есть ли способ сделать макрос, который бы находил уникальное значение "01.12.2023" и после этого делал указанные выше действия?

К сообщению приложен файл: primer.xlsx (9.3 Kb)

Ответить

Gustav

Дата: Среда, 30.08.2023, 15:28 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2766

Репутация: 1140 ±

Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1

Цитата Spirtuoz, 30.08.2023 в 12:09, в сообщении № 1 (

)

есть ли способ сделать макрос?

Есть такой способ!
[vba]

Код

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

[/vba]

МОИ: Ник, Tip box: 41001663842605

Ответить

Nic70y

Дата: Среда, 30.08.2023, 16:50 | Сообщение № 3

Группа: Друзья

Ранг: Экселист

Сообщений: 8887

Репутация: 2324 ±

Замечаний: 0% ±

Excel 2010

так смешнее
[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

[/vba]