Протягивание формулы по условию
|
|
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]
Уважаемые форумчане! Прошу Вас доработать макрос который протягивает формулу из предыдущей строки по условию. [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
Сообщение отредактировал VitaliyPegushin - Вторник, 02.08.2022, 11:27 |
|
| Ответить
|
_Boroda_ |
Дата: Вторник, 02.08.2022, 11:31 |
Сообщение № 2 |
|
Группа: Админы
Ранг: Местный житель
Сообщений: 16714
Репутация:
6503
±
Замечаний:
±
2003; 2007; 2010; 2013 RUS | |
Эта строка [vba]Код cell.Value = cell.Offset(-1, 0).Value [/vba] протягивает не формулу, а значение
Эта строка [vba]Код cell.Value = cell.Offset(-1, 0).Value [/vba] протягивает не формулу, а значение_Boroda_
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
|
|
| Ответить
|
VitaliyPegushin |
Дата: Вторник, 02.08.2022, 11:33 |
Сообщение № 3 |
|
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация:
0
±
Замечаний:
20% ±
Excel 2016 | |
А как протянуть формулу?
|
|
| Ответить
|
_Boroda_ |
Дата: Вторник, 02.08.2022, 11:39 |
Сообщение № 4 |
|
Группа: Админы
Ранг: Местный житель
Сообщений: 16714
Репутация:
6503
±
Замечаний:
±
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]
Включите запись макроса, протяните, посмотрите, что записалось )))
[vba]Код Range("J2").AutoFill Destination:=Range("J2").Resize(2), Type:=xlFillDefault ' или Range("J3").Copy Range("J4").PasteSpecial Paste:=xlPasteFormulas [/vba]
Включите запись макроса, протяните, посмотрите, что записалось )))_Boroda_
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
|
|
| Ответить
|
VitaliyPegushin |
Дата: Вторник, 02.08.2022, 11:58 |
Сообщение № 5 |
|
Группа: Пользователи
Ранг: Новичок
Сообщений: 42
Репутация:
0
±
Замечаний:
20% ±
Excel 2016 | |
Приложил пример таблицы. наименование колонок подогнал под пример, - выдает ошибку.
Приложил пример таблицы. наименование колонок подогнал под пример, - выдает ошибку.VitaliyPegushin
|
|
| Ответить
|
_Boroda_ |
Дата: Вторник, 02.08.2022, 12:15 |
Сообщение № 6 |
|
Группа: Админы
Ранг: Местный житель
Сообщений: 16714
Репутация:
6503
±
Замечаний:
±
2003; 2007; 2010; 2013 RUS | |
К сожалению, я не могу скачивать и выкладывать файлы макросами на этот форум. Безопасники запрет поставили
К сожалению, я не могу скачивать и выкладывать файлы макросами на этот форум. Безопасники запрет поставили_Boroda_
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
|
|
| Ответить
|
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]
Разобрался сам. Все заполняется (единственное после выполнения макроса ошибку Ексель выдает :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
Сообщение отредактировал VitaliyPegushin - Вторник, 02.08.2022, 14:53 |
|
| Ответить
|