Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Протянуть формулы макросом
 
#1
28.04.2011 21:32:38
Добрый вечер!  
Есть макрос, в котором прописаны формулы. Сколько будет заполненных строк в файле, я не знаю. В этом макросе я протянула формулы с учетом 50 000строк, после чего пустые мне нужно удалять, если заполненных строк меньше. Подскажите, пожалуйста, как можно прописать в макросе, что бы формула автоматически останавливалась перед первой пустой строкой, то есть, если в ячейках левее нет значений. Заранее спасибо.  
Sub Контакты_тест()  
'  
' Контакты Макрос  
'  
 
'  
'Переименовывает лист  
   ActiveSheet.Select  
   ActiveSheet.Name = "Контакты"  
'Устанавливает порядок столбцов  
   Range("Q:R").Select  
   Selection.Copy  
   Range("B1").Select  
   ActiveSheet.Paste  
   Columns("G:G").Select  
   Selection.Copy  
   Range("E1").Select  
   ActiveSheet.Paste  
   Columns("P:P").Select  
   Application.CutCopyMode = False  
   Selection.Cut  
   Columns("F:F").Select  
   Selection.Insert Shift:=xlToRight  
   Columns("I:I").Select  
   Selection.Copy  
   Range("H1").Select  
   ActiveSheet.Paste  
   Columns("K:K").Select  
   Selection.Copy  
   Range("I1").Select  
   ActiveSheet.Paste  
   Range("K:W").Select  
   Selection.Delete Shift:=xlToLeft  
'Удаляет время звонка  
   Columns("G:G").Select  
   Selection.TextToColumns Destination:=Range("G1"), DataType:=xlFixedWidth, _  
       FieldInfo:=Array(Array(0, 4), Array(10, 9)), TrailingMinusNumbers:=True  
   Selection.NumberFormat = "m/d/yyyy"  
'Устанавливает значение контакта  
   Range("J2").Select  
   ActiveCell.FormulaR1C1 = _  
       "=IF(RC[-1]=""Обещание оплаты"",""Контакт установлен"",IF(RC[-1]=""Обещание полной оплаты"",""Контакт установлен"",IF(RC[-1]=""Обещание частичной оплаты"",""Контакт установлен"",IF(RC[-1]=""Подтверждение обещания"",""Контакт установлен"",IF(RC[-1]=""Подтверждение оплаты"",""Контакт установлен"",""Контакт не установлен"")))))"
   Range("J2").Select  
   Selection.AutoFill Destination:=Range("J2:J30000")  
   Columns("J:J").Select  
   Selection.Copy  
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
End Sub
 
 
 
#2
28.04.2011 21:38:59
Сначала заглянуть сюда.  
http://www.planetaexcel.ru/forum.php?thread_id=8735  
Затем убрать из макроса 70% мусора.
 
 
 
#3
28.04.2011 21:42:55
Я плохо разбираюсь в макросах, только учусь, поэтому 70% мусора не вижу. он вроде работает...
 
 
 
#4
28.04.2011 21:43:42
Попробуйте  
'Устанавливает значение контакта  
Range("J2:J" & Cells(Rows.Count, "J").End(xlUp).Row) = _  
"=IF(RC[-1]=""Обещание оплаты"",""Контакт установлен"",IF(RC[-1]=""Обещание полной оплаты"",""Контакт установлен"",IF(RC[-1]=""Обещание частичной оплаты"",""Контакт установлен"",IF(RC[-1]=""Подтверждение обещания"",""Контакт установлен"",IF(RC[-1]=""Подтверждение оплаты"",""Контакт установлен"",""Контакт не установлен"")))))"
with Range("J2:J" & Cells(Rows.Count, "J").End(xlUp).Row)  
.value = .value  
end with
 
 
 
#5
28.04.2011 21:51:13
Спасибо Вам большое, все работает!
 
 
 
#6
11.08.2012 10:37:48
А можно ли, для наглядности, то же самое сделать на простом примере?  
Как протянуть макросом формулу из В1 вниз, до последнего значения в столбце А:А?  
Спасибо.
 
 
 
#7
11.08.2012 10:40:38
{quote}{login=Пирогов}{date=11.08.2012 10:37}{thema=}{post}А можно ли, для наглядности...  
Как протянуть макросом формулу...{/post}{/quote}  
1. А можно для наглядности ВАШ файл, в котором должен работать макрос?  
2. Зачем вообще формулы, если будет макрос? Ведь можно сразу значения вносить.
 
 
 
#8
11.08.2012 11:41:05
Макрос выполняет ряд операций, одна из которых-протягивание формул.  
Сейчас формулы протягиваются с запасом, включая пока еще пустые ячейки.  
Можно конечно создать динамичный именованный диапазон, но как его привязать к "протягиванию"?  
Вот и хотел взглянуть на код, который протягивает на нужный диапазон.  
Может как-нибудь бы пристроил...
 
 
 
#9
11.08.2012 11:49:11
Пирогов, из Вашей прошлой темы пора бы понять, что без примера в Вашем файле, это пустой треп. Нам не нужен Ваш рабочий файл. Нарисуйте простой пример на 5-15 строк и оставьте там расположение данных как в рабочем. Поверьте, это в разы сокращает обсуждение.
Я сам - дурнее всякого примера! ...
 
 
 
#10
11.08.2012 12:03:35
Извините...
 
 
 
#11
11.08.2012 12:23:30
Sub www()  
Range("e2:e" & Cells(Rows.Count, 1).End(xlUp).Row).Formula = "=RC[-2]*RC[-1]"
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#12
12.08.2012 11:49:12
KukLP, спасибо.  
Но Макрос не протягивает содержимое ячейки, а вставляет свое(в нашем случае формула перемножения).  
А как сделать протягивание(копирование)без учета содержимого?  
Спасибо?
 
 
 
#13
12.08.2012 11:54:22
{quote}А как сделать протягивание(копирование)без учета содержимого?  
{/quote}  
Самое простое - записать макрос и посмотреть
 
 
 
#14
12.08.2012 12:04:37
Пирогов, это Вы на каком языке вообще пишете? Вы спросили:    
"Как протянуть макросом формулу из В1 вниз, до последнего значения в столбце А:А?"  
Теперь:  
"Но Макрос не протягивает содержимое ячейки, а вставляет свое(в нашем случае формула перемножения)."  
И что такое:"протягивание(копирование)без учета содержимого?"  
Может это:  
Sub www()  
Range("e2:e" & Cells(Rows.Count, 1).End(xlUp).Row).Formula = [e2].formular1c1
End Sub  
?
Я сам - дурнее всякого примера! ...
 
 
 
#15
16.08.2012 11:41:53
KukLP, спасибо.  
Вы все правильно поняли.  
То, что нужно.  
 
P.S.А мне казалось, я так доходчиво излагаю. Вам до меня дурнеть и дурнеть:)
 
 
 
#16
18.08.2012 16:09:44
Никак не успокоюсь...  
Можно ли как-то прикруть(заменить на) функцию FillDown.  
Чтобы еще и форматы копировались?  
спасибо.
 
 
 
#17
18.08.2012 16:41:44
1) Пирогов, функция FillDown - медленная, поэтому лично я ее избегаю, где только можно.  
2) А смысл в протягивании форматов только в одном столбце? Форматирование - тоже медленная операция, поэтому лучше скопировать формат из первой строки и присвоить его сразу всему диапазону. Макрорекордер Вам в помощь. А так же методы intersect, currentregion, offset, pastespecial.  
PS В Вашем примере я не увидел форматирования. ТщательнЕе надо примеры готовить. За сим раскланиваюсь.  
PPS можете считать все вышесказанное домашним заданием:-)
Я сам - дурнее всякого примера! ...
 
 
 
#18
18.08.2012 16:51:29
Ясно.  
Премного благодарен.
 
 
 
#19
18.08.2012 17:10:07
{quote}{login=Пирогов}{date=18.08.2012 04:09}{thema=}{post}Никак не успокоюсь...{/post}{/quote}  
А такое "успокоительное" не принимали?.. Попадите "10" в желтенькое... ;) -44960-
 
 
 
#20
18.08.2012 21:31:01
Вы такое протягивание хотели?  
 
зы. А если использовать таблицы, как в примере Z, то и макросы не нужны.
 
 
 
#21
19.08.2012 12:42:44
Привет  
Гуру, а вот если например, я первый раз протянул формулу до Е4, макрос Михаила срабатывает нормально. Потом мне надо еще протянуть эту формулу дальше. Продлеваю таблицу дальше, в том числе и столбец А, и вот тут макрос выдает ошибку. Удаляю предыдущее протягивание - макрос сработал как надо. Почему так происходит и что нужно подправить , чтобы этой ошибки, при дальнейших протягиваниях, избежать?  
Спасибо за ответ
 
 
 
#22
19.08.2012 13:26:08
Sub Макрос2()  
Dim a, s  
a = Range("e" & Cells(Rows.Count, 5).End(xlUp).Row).Address  
s = a & ":" & Range("e" & Cells(Rows.Count, 1).End(xlUp).Row).Address  
On Error Resume Next  
   Range(a).AutoFill Destination:=Range(s), Type:=xlFillDefault  
End Sub
 
 
 
#23
19.08.2012 13:53:29
Михаил, БЛАГОДАРСТВУЮ  
Теперь совсем др. компот. Работает как нало
 
 
 
#24
20.08.2012 11:42:33
Михаил С., спасибо.  
Думаю, теперь идеально.
 
 
 
Страницы: 1
Читают тему
Наверх