Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Добавление пустых строк после значения - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Добавление пустых строк после значения
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)
 
Ответить
СообщениеДобрый день.

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

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

Автор - Spirtuoz
Дата добавления - 30.08.2023 в 12:09
Gustav Дата: Среда, 30.08.2023, 15:28 | Сообщение № 2
Группа: Админы
Ранг: Участник клуба
Сообщений: 2790
Репутация: 1154 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.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
 
Ответить
Сообщение
есть ли способ сделать макрос?

Есть такой способ!
[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]

Автор - Gustav
Дата добавления - 30.08.2023 в 15:28
Nic70y Дата: Среда, 30.08.2023, 16:50 | Сообщение № 3
Группа: Друзья
Ранг: Экселист
Сообщений: 8984
Репутация: 2359 ±
Замечаний: 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]


ЮMoney 41001841029809
 
Ответить
Сообщениетак смешнее
[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]

Автор - Nic70y
Дата добавления - 30.08.2023 в 16:50
cmivadwot Дата: Среда, 30.08.2023, 23:15 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 531
Репутация: 96 ±
Замечаний: 0% ±

365
Spirtuoz, наколхозил... без макроса, для копирования и вставки только значений...на 173 арендатора..
К сообщению приложен файл: primer_11.xlsx (86.2 Kb)


Сообщение отредактировал cmivadwot - Среда, 30.08.2023, 23:17
 
Ответить
СообщениеSpirtuoz, наколхозил... без макроса, для копирования и вставки только значений...на 173 арендатора..

Автор - cmivadwot
Дата добавления - 30.08.2023 в 23:15
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!