Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Протянуть формулу на определенное количество ячеек, которое равно количеству ячеек в столбце с данными таблицы на другом листе
 
#1
08.10.2021 16:02:42
Добрый день, в примере есть 2 столбца на Листе1 и 2 столбца на Листе2.
Есть ли возможность с помощью макроса узнать количество заполненных ячеек в столбце id на Листе2, и затем протянуть формулы в столбцах h1 и h2 в Листе1 именно на такое количество ячеек?
При этом количество ячеек в столбце id на листе2 всегда будет разное.
Изменено: Joestar - 08.10.2021 16:03:41
 
 
 
#2
08.10.2021 16:17:10
Код
Sub myMacro()
    Sheets("Лист1").Cells(2, 1).Resize(Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row, 2).Formula = Sheets("Лист1").Cells(2, 1).Resize(1, 2).Formula
End Sub
 
 
 
#3
08.10.2021 16:21:17
Код
Sub Протянуть_формулы()
    Dim LastRowSht1 As Long, LastRowSht2 As Long
    
    With Worksheets("Лист2")
        LastRowSht2 = .Cells(.Rows.Count, 1).End(xlUp).Row 'последняя строка в столбце А на Лист2
    End With
    
    With Worksheets("Лист1")
        LastRowSht1 = .Cells(.Rows.Count, 1).End(xlUp).Row 'последняя строка в столбце А на Лист1
        'если строк на Лист1 меньше или равно кол-ву строк на Лист2
        If LastRowSht1 <= LastRowSht2 Then
            'то протятигиваем формулы
            .Range("A2:B2").AutoFill Destination:=.Range("A2:B" & LastRowSht2), Type:=xlFillDefault
        Else
            'иначе (если строк на Лист1 больше, чем на Лист2)
            .Range("A3:B" & LastRowSht1).ClearContents 'очищаем строки на Лист1
            'протягиваем формулы по размеру кол-ву строк на Лист2
            .Range("A2:B2").AutoFill Destination:=.Range("A2:B" & LastRowSht2), Type:=xlFillDefault
        End If
    End With
End Sub
Изменено: New - 08.10.2021 19:02:50
 
 
 
#4
08.10.2021 16:24:51
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    lr1 = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Лист1")
        lr2 = .Cells(.Rows.Count, 1).End(xlUp).Row
        If lr1 > lr2 Then
            .[A2:B2].AutoFill Destination:=.Range("A2:B" & lr1)
       End If
    End With
End Sub
Мой канал
 
 
 
#5
08.10.2021 16:35:32
Буквально пару дней назад обсуждали, можно ли оценивать код по количеству строчек.
Сообщения #2 и #3 можно приводить в пример при таких обсуждениях )

Обсуждали тут: Ищу программиста-макросника на фриланс (planetaexcel.ru)
 
 
 
#6
08.10.2021 16:40:35
Я сторонник включать в код хотя бы минимальные проверки/обработки ошибок (попробуй протянуть формулы на Лист1 до 100-й строки, а потом запусти свой макрос)
+ читаемость кода для новичков, чтобы они смогли скорректировать код под себя в будущем
P.S. Я бы сказал так - твой код написан "для себя" - коротко и понятно (нам с тобой). А мой код написан "для клиента" - длинно, с описанием логики, а так же с проверкой и корректировкой строк на Лист1 (если на Лист1 будет больше строк, чем на Лист2, то лишние строки будут очищены), с комментариями, чтобы клиент понял код для себя и в случае чего смог скорректировать его, если что-то изменится в будущем
P.P.S. Если говорить про макросы на заказ (за деньги) - я пишу именно в стиле "для клиента" - во-первых, добавляю разные проверки, во-вторых, если клиент через год наймём другого исполнителя, чтобы доработать мой код, то новому исполнителю мой код будет легче читать и исправлять/дописывать, добавлены комментарии. А так - дай задание 10 программистам и ты получишь 10 разных кодов.
Мы накидали разных вариантов кодов, а какой выбрать пусть решает ТС.
Изменено: New - 08.10.2021 21:14:48
 
 
 
#7
08.10.2021 16:47:46
New, для полезности такое оформление как у Вас и нужно  
 
 
 
#8
08.10.2021 18:32:21
Код
=ИНДЕКС(Лист2!A:A;ПОСЛЕД(СЧЁТЗ(Лист2!A:A)-1;1;2))
 
 
 
#9
08.10.2021 18:38:56
New, спасибо большое за комментарии, вроде как разобрался.

А если в таблице на листе1 будут столбцы не от A до B, а от A до O, то формула будет выглядеть вот так?
Код
Sub Протянуть_формулы()
    Dim LastRowSht1 As Long, LastRowSht2 As Long
     
    With Worksheets("list2")
        LastRowSht2 = .Cells(.Rows.Count, 1).End(xlUp).Row 'последняя строка в столбце А на Лист2
    End With
     
    With Worksheets("list1")
        LastRowSht1 = .Cells(.Rows.Count, 1).End(xlUp).Row 'последняя строка в столбце А на Лист1
        'если строк на Лист1 меньше или равно кол-ву строк на Лист2
        If LastRowSht1 <= LastRowSht2 Then
            'то проятигиваем формулы
            .Range("A2:O2").AutoFill Destination:=.Range("A2:O" & LastRowSht2), Type:=xlFillDefault
        Else
            'иначе (если строк на Лист1 больше, чем на Лист2
            .Range("A3:O" & LastRowSht1).ClearContents 'очищаем строки на Лист1
            'протягиваем формулы по размеру кол-ву строк на Лист2
            .Range("A2:O2").AutoFill Destination:=.Range("A2:O" & LastRowSht2), Type:=xlFillDefault
        End If
    End With
End Sub
 
 
 
#10
08.10.2021 18:52:44
как будет выглядеть формула, я не знаю. А вот код макроса - думаю да, так (заменить все B на О)
Вы попробуйте запустить ваш макрос и если он всё правильно отработал и формулы протянулись верно, то значит и ваш макрос верный
P.S. Мы же с вами пишем макрос, а формулы у вас записаны на листе Excel
Изменено: New - 08.10.2021 18:54:26
 
 
 
#11
08.10.2021 18:56:20
New, да, я и имел ввиду код, а не формулу))
код работает, спасибо вам.
 
 
 
#12
08.10.2021 20:57:26
Цитата
New написал:
я сторонник включать в код хотя бы минимальные проверки/обработки ошибок... ...А мой код написан "для клиента"
Поддерживаю целиком и полностью. Бывает что через какое-то время свой же код не могу разобрать, если не сделал пояснения.
 
 
 
#13
11.10.2021 09:58:56
Не поймите меня правильно )
Не оценивал сами макросы. Я имел в виду, что при более менее одинаковом результате, при оплате построчно, за макрос из сообщения #2 заплатили бы в семь раз меньше, чем за макрос из сообщения #3. Я про то, что такой подход хоть и допустим, но имеет некоторые недостатки. И вот, собственно, пример.
 
 
 
#14
11.10.2021 10:10:00
Цитата
New: Я сторонник включать в код хотя бы минимальные проверки/обработки ошибок
Цитата
cuprum: Поддерживаю … свой же код не могу разобрать, если не сделал пояснения
пояснения (комментарии) и обработка возможных вариантов/ошибок — далеко не одно и то же  ;)

New, +1. Короткие конструкции на штатных комплексных методах Excel мало того, что очень узкоприменимые, ошибкособирательные, негибкие и непонятные простому пользователю, так ещё и практически всегда более медленные (вспомнил пример из моей засраной темы)  :D
Изменено: Jack Famous - 11.10.2021 10:10:57
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Наверх