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

Вход

Регистрация

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

 

= Мир MS Excel/Протягивание формулы по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Протягивание формулы по условию (Формулы/Formulas)
Протягивание формулы по условию
VitaliyPegushin Дата: Вторник, 02.08.2022, 11:26 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Уважаемые форумчане!
Прошу Вас доработать макрос который протягивает формулу из предыдущей строки по условию.
[vba]
Код
Sub Автозаполнение_формул()
    Dim lr As Long, i As Long
   
    ' Отключение монитора, чтобы ускорить макрос.
        ' Можно ещё отключить формулы, если их много.
    Application.ScreenUpdating = False
   
    ' Поиск последней заполненной строки в столбце I.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "I").End(xlUp).Row
   
    ' Движение по строкам со строки 24 до последней строки.
    For i = 24 To lr
       
        ' Если есть пустое значение ячейки в столбце I, то переход на следующую строку.
        If (Cells(i, "I").Value = "") Then
            GoTo СледСтрока
        End If
        
       ' Заполнение ячейки в столбце J.
        '* Если ячейка в столбце J пустая.
        If Cells(i, "J").Value = "" Then
        cell.Value = cell.Offset(-1, 0).Value
        End If
       
      
        
СледСтрока:
    Next i
   
    ' Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Пустые ячейки заполнены", vbInformation

End Sub
[/vba]


Сообщение отредактировал VitaliyPegushin - Вторник, 02.08.2022, 11:27
 
Ответить
СообщениеУважаемые форумчане!
Прошу Вас доработать макрос который протягивает формулу из предыдущей строки по условию.
[vba]
Код
Sub Автозаполнение_формул()
    Dim lr As Long, i As Long
   
    ' Отключение монитора, чтобы ускорить макрос.
        ' Можно ещё отключить формулы, если их много.
    Application.ScreenUpdating = False
   
    ' Поиск последней заполненной строки в столбце I.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "I").End(xlUp).Row
   
    ' Движение по строкам со строки 24 до последней строки.
    For i = 24 To lr
       
        ' Если есть пустое значение ячейки в столбце I, то переход на следующую строку.
        If (Cells(i, "I").Value = "") Then
            GoTo СледСтрока
        End If
        
       ' Заполнение ячейки в столбце J.
        '* Если ячейка в столбце J пустая.
        If Cells(i, "J").Value = "" Then
        cell.Value = cell.Offset(-1, 0).Value
        End If
       
      
        
СледСтрока:
    Next i
   
    ' Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Пустые ячейки заполнены", vbInformation

End Sub
[/vba]
Автор - VitaliyPegushin
Дата добавления - 02.08.2022 в 11:26
_Boroda_ Дата: Вторник, 02.08.2022, 11:31 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16675
Репутация: 6481 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Эта строка
[vba]
Код
cell.Value = cell.Offset(-1, 0).Value
[/vba]
протягивает не формулу, а значение

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЭта строка
[vba]
Код
cell.Value = cell.Offset(-1, 0).Value
[/vba]
протягивает не формулу, а значение
Автор - _Boroda_
Дата добавления - 02.08.2022 в 11:31
VitaliyPegushin Дата: Вторник, 02.08.2022, 11:33 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
А как протянуть формулу?
 
Ответить
СообщениеА как протянуть формулу?
Автор - VitaliyPegushin
Дата добавления - 02.08.2022 в 11:33
_Boroda_ Дата: Вторник, 02.08.2022, 11:39 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16675
Репутация: 6481 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
[vba]
Код
Range("J2").AutoFill Destination:=Range("J2").Resize(2), Type:=xlFillDefault
    ' или
    Range("J3").Copy
    Range("J4").PasteSpecial Paste:=xlPasteFormulas
[/vba]

Включите запись макроса, протяните, посмотрите, что записалось )))

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение[vba]
Код
Range("J2").AutoFill Destination:=Range("J2").Resize(2), Type:=xlFillDefault
    ' или
    Range("J3").Copy
    Range("J4").PasteSpecial Paste:=xlPasteFormulas
[/vba]

Включите запись макроса, протяните, посмотрите, что записалось )))
Автор - _Boroda_
Дата добавления - 02.08.2022 в 11:39
VitaliyPegushin Дата: Вторник, 02.08.2022, 11:58 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Приложил пример таблицы. наименование колонок подогнал под пример, - выдает ошибку.
К сообщению приложен файл: 7769591-1-.xlsm (38.8 Kb)
 
Ответить
СообщениеПриложил пример таблицы. наименование колонок подогнал под пример, - выдает ошибку.
Автор - VitaliyPegushin
Дата добавления - 02.08.2022 в 11:58
_Boroda_ Дата: Вторник, 02.08.2022, 12:15 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16675
Репутация: 6481 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
К сожалению, я не могу скачивать и выкладывать файлы макросами на этот форум. Безопасники запрет поставили

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеК сожалению, я не могу скачивать и выкладывать файлы макросами на этот форум. Безопасники запрет поставили
Автор - _Boroda_
Дата добавления - 02.08.2022 в 12:15
VitaliyPegushin Дата: Вторник, 02.08.2022, 14:52 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Разобрался сам. Все заполняется (единственное после выполнения макроса ошибку Ексель выдает :Run-time error 13, Type mismatch
Код прилагаю: [vba]
Код

Sub Автозаполнение_формул()
    Dim lr As Long, i As Long
   
    ' Отключение монитора, чтобы ускорить макрос.
        ' Можно ещё отключить формулы, если их много.
    Application.ScreenUpdating = False
   
    ' Поиск последней заполненной строки в столбце I.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "I").End(xlUp).Row
   
    ' Движение по строкам со строки 24 до последней строки.
    For i = 24 To lr
       
        ' Если есть пустое значение ячейки в столбце I, то переход на следующую строку.
        If (Cells(i, "I").Value = "") Then
            GoTo СледСтрока
        End If
        
       ' Заполнение ячейки в столбце BX.
        '* Если ячейка в столбце BX пустая.
       
       '
       If Cells(i, "BX").Value = "" Then  ' Заполнение ячейки в столбце BX.
            Cells(i, "BX").Value = "=Таблица24[@Столбец1]"
        End If
      

СледСтрока:
    Next i
   
    ' Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Пустые ячейки заполнены", vbInformation

End Sub
[/vba]


Сообщение отредактировал VitaliyPegushin - Вторник, 02.08.2022, 14:53
 
Ответить
СообщениеРазобрался сам. Все заполняется (единственное после выполнения макроса ошибку Ексель выдает :Run-time error 13, Type mismatch
Код прилагаю: [vba]
Код

Sub Автозаполнение_формул()
    Dim lr As Long, i As Long
   
    ' Отключение монитора, чтобы ускорить макрос.
        ' Можно ещё отключить формулы, если их много.
    Application.ScreenUpdating = False
   
    ' Поиск последней заполненной строки в столбце I.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "I").End(xlUp).Row
   
    ' Движение по строкам со строки 24 до последней строки.
    For i = 24 To lr
       
        ' Если есть пустое значение ячейки в столбце I, то переход на следующую строку.
        If (Cells(i, "I").Value = "") Then
            GoTo СледСтрока
        End If
        
       ' Заполнение ячейки в столбце BX.
        '* Если ячейка в столбце BX пустая.
       
       '
       If Cells(i, "BX").Value = "" Then  ' Заполнение ячейки в столбце BX.
            Cells(i, "BX").Value = "=Таблица24[@Столбец1]"
        End If
      

СледСтрока:
    Next i
   
    ' Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Пустые ячейки заполнены", vbInformation

End Sub
[/vba]
Автор - VitaliyPegushin
Дата добавления - 02.08.2022 в 14:52
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Протягивание формулы по условию (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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