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

Вход

Регистрация

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

 

= Мир MS Excel/Продление формул при заполнении таблицы - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Продление формул при заполнении таблицы (Макросы/Sub)
Продление формул при заполнении таблицы
KiTrOd Дата: Четверг, 20.10.2016, 13:54 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Здравствуйте. Помогите пожалуйста с макросом. Формулами не получилось. Есть файл с большим количеством листов, листы связаны друг с другом формулами. Руками заполняется только Лист1. Так как листов много и в каждом по несколько таблиц, то при заполнении Лист1, нужно потом руками протягивать формулы по всем следующим листам. Хочу этот процесс автоматизировать.
К сообщению приложен файл: 3819599.xlsx(11Kb)
 
Ответить
СообщениеЗдравствуйте. Помогите пожалуйста с макросом. Формулами не получилось. Есть файл с большим количеством листов, листы связаны друг с другом формулами. Руками заполняется только Лист1. Так как листов много и в каждом по несколько таблиц, то при заполнении Лист1, нужно потом руками протягивать формулы по всем следующим листам. Хочу этот процесс автоматизировать.

Автор - KiTrOd
Дата добавления - 20.10.2016 в 13:54
Karataev Дата: Четверг, 20.10.2016, 14:21 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 643
Репутация: 227 ±
Замечаний: 0% ±

Excel
Перед запуском макроса перейдите на лист1. Или можно изменить макрос, добавив в него указание листа.
Макрос обрабатывает листы со 2 по последний.
Принцип макроса такой. Если на листе 2 строк меньше, чем на листе 1, то на листе 2 копируется строка 3 и вставляется под таблицей. Если на листе 2 строк больше, чем на листе 1, то лишние строки удаляются.
[vba]
Код
Sub Продлить()
    
    Dim sh As Worksheet
    Dim lr1 As Long, lr2 As Long, i As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    lr1 = Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    
    For i = 2 To Worksheets.Count
        Set sh = Worksheets(i)
        lr2 = sh.Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
                xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
                , SearchFormat:=False).Row
        If lr2 < 3 Then
            MsgBox "На листе " & sh.Name & " вставьте сначала вручную строку 3!", vbExclamation
        ElseIf lr2 > lr1 Then
            sh.Rows(lr1 + 1 & ":" & lr2).Delete
        ElseIf lr2 < lr1 Then
            sh.Rows(3).Copy sh.Rows(lr2 + 1 & ":" & lr1)
        End If
    Next

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "Готово!", vbInformation

End Sub
[/vba]




Сообщение отредактировал Karataev - Четверг, 20.10.2016, 14:24
 
Ответить
СообщениеПеред запуском макроса перейдите на лист1. Или можно изменить макрос, добавив в него указание листа.
Макрос обрабатывает листы со 2 по последний.
Принцип макроса такой. Если на листе 2 строк меньше, чем на листе 1, то на листе 2 копируется строка 3 и вставляется под таблицей. Если на листе 2 строк больше, чем на листе 1, то лишние строки удаляются.
[vba]
Код
Sub Продлить()
    
    Dim sh As Worksheet
    Dim lr1 As Long, lr2 As Long, i As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    lr1 = Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    
    For i = 2 To Worksheets.Count
        Set sh = Worksheets(i)
        lr2 = sh.Columns("A").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
                xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
                , SearchFormat:=False).Row
        If lr2 < 3 Then
            MsgBox "На листе " & sh.Name & " вставьте сначала вручную строку 3!", vbExclamation
        ElseIf lr2 > lr1 Then
            sh.Rows(lr1 + 1 & ":" & lr2).Delete
        ElseIf lr2 < lr1 Then
            sh.Rows(3).Copy sh.Rows(lr2 + 1 & ":" & lr1)
        End If
    Next

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "Готово!", vbInformation

End Sub
[/vba]

Автор - Karataev
Дата добавления - 20.10.2016 в 14:21
KiTrOd Дата: Четверг, 20.10.2016, 20:42 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 16
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Karataev, спасибо, пробую применить
 
Ответить
СообщениеKarataev, спасибо, пробую применить

Автор - KiTrOd
Дата добавления - 20.10.2016 в 20:42
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Продление формул при заполнении таблицы (Макросы/Sub)
Страница 1 из 11
Поиск:

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