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

Вход

Регистрация

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

 

= Мир MS Excel/код работает правильно "через раз" - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » код работает правильно "через раз" (Макросы/Sub)
код работает правильно "через раз"
hyper Дата: Понедельник, 23.02.2015, 16:41 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день!

Товарищи для автопротяжки решил использовать макрос. Макрос нашёл в сети и адаптировал для себя:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)

        Dim r As Long, Lr As Long
        If Target.Column =6 Then
            Application.EnableEvents = False
            r = Cells(Rows.Count, "F").End(xlUp).Row: Lr = Cells.SpecialCells(xlCellTypeLastCell).Row
            [J4:P4].AutoFill Destination:=Range([J4], Cells(Lr, "P")), Type:=xlFillDefault
            Range(Cells(r + 1, "F"), Cells(Lr, "P")).Delete Shift:=xlUp
            Application.EnableEvents = True
        End If

End Sub
[/vba]

Что я жду от данной формулы:
При заполнении колонки F(6 колонка) происходила автопротяжка формул в колонках с J по Р При удалении значения с колонки F - автоматическое удаление формул с колонок J по P.

Макрос вроде работает, но
1. Иногда удаляет значение, которые я ввожу в колонку F - а не должен!
2. При протяжке он заполняет все строки, а потом удаляет ненужные до последнего значения в столбце F - занимает много времени.
3. Перепротягивает все формулы заного при добавлении нового значения в колонку F - занимает много времени.

Помогите, пожалуйста, подредактировать код, что бы он нормально работал.
[moder]Файл, согласно Правилам форума, приложите - поможем.
К сообщению приложен файл: primer1.xlsb (13.2 Kb)


Сообщение отредактировал hyper - Понедельник, 23.02.2015, 17:30
 
Ответить
СообщениеДобрый день!

Товарищи для автопротяжки решил использовать макрос. Макрос нашёл в сети и адаптировал для себя:

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)

        Dim r As Long, Lr As Long
        If Target.Column =6 Then
            Application.EnableEvents = False
            r = Cells(Rows.Count, "F").End(xlUp).Row: Lr = Cells.SpecialCells(xlCellTypeLastCell).Row
            [J4:P4].AutoFill Destination:=Range([J4], Cells(Lr, "P")), Type:=xlFillDefault
            Range(Cells(r + 1, "F"), Cells(Lr, "P")).Delete Shift:=xlUp
            Application.EnableEvents = True
        End If

End Sub
[/vba]

Что я жду от данной формулы:
При заполнении колонки F(6 колонка) происходила автопротяжка формул в колонках с J по Р При удалении значения с колонки F - автоматическое удаление формул с колонок J по P.

Макрос вроде работает, но
1. Иногда удаляет значение, которые я ввожу в колонку F - а не должен!
2. При протяжке он заполняет все строки, а потом удаляет ненужные до последнего значения в столбце F - занимает много времени.
3. Перепротягивает все формулы заного при добавлении нового значения в колонку F - занимает много времени.

Помогите, пожалуйста, подредактировать код, что бы он нормально работал.
[moder]Файл, согласно Правилам форума, приложите - поможем.

Автор - hyper
Дата добавления - 23.02.2015 в 16:41
Manyasha Дата: Понедельник, 23.02.2015, 22:20 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Попробуйте так:[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
     Dim r As Long, Lr As Long
     If Target.Column = 6 Then
         Application.EnableEvents = False
         r = Cells(Rows.Count, "F").End(xlUp).Row: Lr = Cells(Rows.Count, "P").End(xlUp).Row
         [J4:P4].AutoFill Destination:=Range([J4], Cells(r, "P")), Type:=xlFillDefault
         If Lr > r Then Range(Cells(r + 1, "F"), Cells(Lr, "P")).Delete Shift:=xlUp
         Application.EnableEvents = True
     End If
End Sub
[/vba]
Тогда ненужные ячейки не будут заполнятся формулами (см строчку Destination:=Range([J4], Cells(r, "P"))).
Удаляются формулы только при условии Lr > r, определение Lr тоже изменила.
К сообщению приложен файл: primer2.xlsb (13.3 Kb)


ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеПопробуйте так:[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
     Dim r As Long, Lr As Long
     If Target.Column = 6 Then
         Application.EnableEvents = False
         r = Cells(Rows.Count, "F").End(xlUp).Row: Lr = Cells(Rows.Count, "P").End(xlUp).Row
         [J4:P4].AutoFill Destination:=Range([J4], Cells(r, "P")), Type:=xlFillDefault
         If Lr > r Then Range(Cells(r + 1, "F"), Cells(Lr, "P")).Delete Shift:=xlUp
         Application.EnableEvents = True
     End If
End Sub
[/vba]
Тогда ненужные ячейки не будут заполнятся формулами (см строчку Destination:=Range([J4], Cells(r, "P"))).
Удаляются формулы только при условии Lr > r, определение Lr тоже изменила.

Автор - Manyasha
Дата добавления - 23.02.2015 в 22:20
hyper Дата: Вторник, 24.02.2015, 20:05 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо большое! Работает намного быстрее!
Но вот только я не понял по какому принципу удаляется?

Если удалить значение из колонки F , то удаляется протяжка до последнего заполненного значения в колонке F?


Сообщение отредактировал hyper - Вторник, 24.02.2015, 20:08
 
Ответить
СообщениеСпасибо большое! Работает намного быстрее!
Но вот только я не понял по какому принципу удаляется?

Если удалить значение из колонки F , то удаляется протяжка до последнего заполненного значения в колонке F?

Автор - hyper
Дата добавления - 24.02.2015 в 20:05
Manyasha Дата: Вторник, 24.02.2015, 21:50 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
Да, если Вы удаляете значение из колонки F, значит номер последней заполненной ячейки в F меньше номера последней заполненной ячейки в P. Тогда удаляем формулы из диапазона F<посл. ячейка +1>:P<посл. ячейка>. Удалять, кстати можно не по одной строке, а сразу несколько, также и добавлять (например, скопировать в F 5 любых значений - формулы протянутся на все новые 5 строчек).
Макрос не сработает, если будете работать с НЕпоследними ячейками в F, т.к. Cells(Rows.Count, "F").End(xlUp).Row берет номер именно последней строчки.

Если что-то не понятно, можете остановить макрос на какой-нибудь строчке (клавишей F9), например на [J4:P4]... и посмотреть значения переменных r и Lr.


ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha - Вторник, 24.02.2015, 23:15
 
Ответить
СообщениеДа, если Вы удаляете значение из колонки F, значит номер последней заполненной ячейки в F меньше номера последней заполненной ячейки в P. Тогда удаляем формулы из диапазона F<посл. ячейка +1>:P<посл. ячейка>. Удалять, кстати можно не по одной строке, а сразу несколько, также и добавлять (например, скопировать в F 5 любых значений - формулы протянутся на все новые 5 строчек).
Макрос не сработает, если будете работать с НЕпоследними ячейками в F, т.к. Cells(Rows.Count, "F").End(xlUp).Row берет номер именно последней строчки.

Если что-то не понятно, можете остановить макрос на какой-нибудь строчке (клавишей F9), например на [J4:P4]... и посмотреть значения переменных r и Lr.

Автор - Manyasha
Дата добавления - 24.02.2015 в 21:50
hyper Дата: Среда, 25.02.2015, 19:26 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Я в основном работаю только с последними или с сотней тысяч последних)))

Помогите, пожалуйста, ещё с одной задачей. А если мне нужно автопротяжку использовать ещё в некоторых столбцах, но с перерывами в несколько столбцов. Как в примере 3.
Пытаюсь добавить дополнительно их, но к сожалению не получается.
К сообщению приложен файл: primer3.xlsb (13.8 Kb)
 
Ответить
СообщениеЯ в основном работаю только с последними или с сотней тысяч последних)))

Помогите, пожалуйста, ещё с одной задачей. А если мне нужно автопротяжку использовать ещё в некоторых столбцах, но с перерывами в несколько столбцов. Как в примере 3.
Пытаюсь добавить дополнительно их, но к сожалению не получается.

Автор - hyper
Дата добавления - 25.02.2015 в 19:26
Manyasha Дата: Четверг, 26.02.2015, 07:47 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
hyper, просто в коде замените столбец P на последний столбец (AE). Или просто добавьте второй диапазон (в файле под комментариями):
[vba]
Код
[J4:P4].AutoFill Destination:=Range([J4], Cells(r, "P")), Type:=xlFillDefault
[T4:AE4].AutoFill Destination:=Range([T4], Cells(r, "AE")), Type:=xlFillDefault
If Lr > r Then Range(Cells(r + 1, "F"), Cells(Lr, "P")).Delete Shift:=xlUp: Range(Cells(r + 1, "T"), Cells(Lr, "AE")).Delete Shift:=xlUp
[/vba]
К сообщению приложен файл: 5735576.xlsb (12.3 Kb)


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеhyper, просто в коде замените столбец P на последний столбец (AE). Или просто добавьте второй диапазон (в файле под комментариями):
[vba]
Код
[J4:P4].AutoFill Destination:=Range([J4], Cells(r, "P")), Type:=xlFillDefault
[T4:AE4].AutoFill Destination:=Range([T4], Cells(r, "AE")), Type:=xlFillDefault
If Lr > r Then Range(Cells(r + 1, "F"), Cells(Lr, "P")).Delete Shift:=xlUp: Range(Cells(r + 1, "T"), Cells(Lr, "AE")).Delete Shift:=xlUp
[/vba]

Автор - Manyasha
Дата добавления - 26.02.2015 в 07:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » код работает правильно "через раз" (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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