Вставка в отфильтрованные строки
Весьма распространенная ситуация, вопрос про которую мне задают почти на каждом тренинге. Есть таблица, в которой Фильтром (Данные - Фильтр) отобраны несколько строк. Задача - вставить какие-либо нужные нам значения именно в видимые отфильтрованные строки, пропуская при этом скрытые. Обычное копирование-вставка при этом не сработает, т.к. данные вставятся не только в видимые, но и в скрытые ячейки. Давайте посмотрим, как можно обойти эту проблему.
Способ 1. Вставка одинаковых значений или формул
Если вам нужно вставить одни и те же значения во все отфильтрованные строки списка, то все просто. Предположим, что у нас есть вот такой список сделок:
... и в нем нужно поставить фиксированную скидку в 1000 рублей каждому "Ашану".
Фильтруем наш список Автофильтром, оставляя на экране только "Ашаны". Вводим нужное значение в первую ячейку и протягиваем (копируем за правый нижний угол ячейки) вниз:
Умный Excel в данном случае понимает, что вы хотите ввести значения именно в отфильтрованные ячейки и делает то, что нужно:
Такой способ подойдет и для ввода значений и для ввода формул. Например, если скидка для "Ашанов" не фиксированная, а составляет 10% от суммы сделки, то в первую отфильтрованную строку можно ввести не константу (1000), а формулу (=C2*10%) и также скопировать вниз.
Способ 2. Макрос вставки любых значений
Другое дело, если вам необходимо вставить в отфильтрованные ячейки не одинаковые значения или формулы, а разные, да еще и брать их из другого диапазона. Тогда придется использовать несложный макрос. Нажмите сочетание клавиш Alt+F11, в открывшемся окне Visual Basic вставьте новый пустой модуль через меню Insert - Module и скопируйте туда этот код:
Sub PasteToVisible()
Dim copyrng As Range, pasterng As Range
Dim cell As Range, i As Long
'запрашиваем у пользователя по очереди диапазоны копирования и вставки
Set copyrng = Application.InputBox("Диапазон копирования", "Запрос", Type:=8)
Set pasterng = Application.InputBox("Диапазон вставки", "Запрос", Type:=8)
'проверяем, чтобы они были одинакового размера
If pasterng.SpecialCells(xlCellTypeVisible).Cells.Count <> copyrng.Cells.Count Then
MsgBox "Диапазоны копирования и вставки разного размера!",vbCritical
Exit Sub
End If
'переносим данные из одного диапазона в другой только в видимые ячейки
i = 1
For Each cell In pasterng
If cell.EntireRow.Hidden = False Then
cell.Value = copyrng.Cells(i).Value
i = i + 1
End If
Next cell
End Sub
Как легко сообразить, макрос запрашивает у пользователя по очереди два диапазона - копирования и вставки. Затем проверяет, чтобы их размеры совпадали, т.к. разница в размерностях вызовет впоследствии ошибку при вставке. Затем макрос перебирает все ячейки в диапазоне вставки и переносит туда данные из диапазона копирования, если строка видима (т.е. не отфильтрована).
Ссылки по теме
Сначала поступаем так же как и в способе 1: фильтруем, в первую ячейку вводим нужное значение или формулу. А затем копируем ячейку с введенным значением, далее (не отменяя копирования) выделяем нужный диапазон - поскольку это обычно весь столбец, то удобно использовать ctrl+shif+вверх/вниз. Далее нажимаем ctrl+G, нажимаем кнопку "Выделить", отмечаем пункт "только видимые ячейки", далее "ОК" и вставка. Ву-а-ля
Чем для меня он лучше Способа №1? Иногда приходится вот таким образом вставлять данные на диапазоне в несколько тысяч строк - замахаешься тянуть за уголок. Двойной щелчок на угле ячейки не сработает на весь диапазон, если в ячейках диапазона есть пропуски (пустые ячейки среди полных) или наоборот - а у меня такое часто и густо....
1. отфильтровать
2. выделить весь столбец - F5 - Выделить - Только видимые
3. не снимая выделения, ввести формулу в первую ячейку и нажать Ctrl+Enter
Спасибо за полезное уточнение
Ctrl+R заполняет выделенные ячейки в строке.
1. Фильтруем, в первую ячейку вводим данные
2. Стоя на ячейке, нажимаем Ctrl + C, ячейка выделяется подвижным пунктиром
3. Далее выделяем оставшиеся ячейки столбца. Лично мне удобно для скорости встать на последнюю ячейку столбца, зажать Shift и с помощью бегунка вернуться в начало столбца и нажать на ячейку, которая под копируемой. В результате выделяется весь столбец.
4. Нажимает Enter. Всё скопировалось.
Достаточно давно написал код, который выложен в статье. Можно скопировать только видимые ячейки и вставить так же только в видимые. Могут быть скрыты как строки, так и столбцы. В общем совершенно без разницы что и как скрыто, вставлено будет в то, что видно
Очень часто приходится работать с большими таблицами данных (до 10000 строк). Постоянно сталкиваюсь со следующей проблемой - при фильтрации строк по какому либо параметру, в случае если этих строк отфильтровалось довольно мало - таблица начинает жутко тормозить (процессор i7 + 4 Гб оперативы) и работать с ней практически невозможно.
Вопрос - есть ли альтернативные способы работы с фильтрацией больших таблиц ? Причем уточнюсь - мне не нужны результаты какого либо подсчета - для этого я пользуюсь сводными таблицами. Мне нужно копировать отфильтрованные данные или тупо посмотреть результат фильтрации находящийся в конце таблицы.
Спасибо.
"Диапазон копирования и вставки разного размера" - хотя размеры одинаковы. Если же беру тот же лист с которого копирую, переношу в книгу в которую вставляю, всё работает (так что проблема точно не в размерах).
Вы не могли бы его адаптировать для работы с разными книгами?
Повесила макрос на горячую клавишу и красота
Вопрос.
1. Как провести копирование данных из одного фильтрованного диапазона в аналогичных по размерам другой?
2. Как сохранить макрос так, чтоб его можно было использовать в других открытых\созданных файлах, чтоб он стал "постоянным"?
Заранее спасибо !
Sub PasteToVisible()
Dim copyrng As Range, pasterng As Range
Dim cell As Range, i As Long
'запрашиваем у пользователя по очереди диапазоны копирования и вставки
Set copyrng = Application.InputBox("Диапазон копирования", "Запрос", Type:=8)
Set pasterng = Application.InputBox("Диапазон вставки", "Запрос", Type:=8)
'проверяем, чтобы они были одинакового размера
If pasterng.Cells.Cells.Count <> copyrng.Cells.Count Then
MsgBox "Диапазоны копирования и вставки разного размера!",vbCritical
Exit Sub
End If
'переносим данные из одного диапазона в другой только в видимые ячейки
For Each cell In pasterng
If cell.EntireRow.Hidden = False Then
cell.Value = Cells(cell.Row, copyrng.Column).Value
End If
Next cell
End Sub
как обойти?
Вопрос: при указании диапазонов копирования и вставки не дает перейти на другую книгу (ни Alt+Tab, ни через панель задач не переключает). Это только у меня так или это особенность макроса?
=b1
=b2
=b3
...
Мне нужно перенести эти формулы в отфильтрованные ячейки. Если нет, то может можете подсказать другой вариант?
За макрос отдельный РЕСПЕКТ!!!
Фильтр сняла, вернее, поставила галочки у всех значений, как у вас в видео. Здесь было все нормально, все вернулось к прежнему виду, правда, я не проверила всю портянку. Только вот почему-то после нажатия кнопки сохранить мне выпало окошко — как будто ошибка. Там написано:
"выгрузка.csv" может содержать возможности несовместимые с форматом "CSV( разделители - запятые)". Сохранить книгу в этом формате?
Чтобы сохранить этот формат, удалив все несовместимые возможности, нажмите кнопку Да.
Чтобы сохранить все возможности, нажмите кнопку нет и сохраните файл в формате последней версии excel.
Чтобы узнать, какие возможности могут быть потеряны, нажмите кнопку Справка.
И вот я теперь не знаю, на какую кнопку нажимать, и что за возможности потеряются... Файл выгрузки большой — столбцов много, мне можно менять значения только одного столбца. Подскажите, что значит это сообщение?
У меня есть таблица с ФИО, где напротив выбранных нужно вставить сумму. Я произвожу следующие действия:
1. Копирую данные, которые необходимо вставить около фамилий.
2. Затем около отфильтрованного списка фамилий в нужном столбце выделяю нужное количество ячеек, нажимаю F5 -- выделить -- только видимые ячейки. Выделяются нужные ячейки и я правой клавишей мыши вставляю туда уже заранее скопированные данные.
Но вставить данные корректно, так, как мне надо, не получается. Допустим, таблица имеет следующий вид:
Я отфильтровываю список и оставляю видимыми только фамилии Афиногенов, Сеченова и Антонова, напротив которых нужно вставить суммы 20000, 40000, 50000. Но данные встают напротив этих фамилий: 20000, 20000, 20000. Если снять фильтр и раскрыть весь список, то увидим то, что выше в таблице. Данные попадают даже туда, где списка нет. Что же делать? Уже давно пытаюсь решить эту проблему и ничего не получается... Подскажите мне, пожалуйста!!!
Вставляю из другой таблицы в свою отфильтрованную таблицу какие-нибудь значения. Убираю фильтр, позже в ходе работы натыкаюсь на эти значения в НЕНУЖНЫХ строках.
Как такое происходит? До сих пор не могу понять?
В отфильтрованной таблице можно протягивать?
Можно вставлять необходимую инфу выделяя в столбце сразу несколько строк-> ctrl v?
Способ нельзя применять, если в колонке получателе есть формулы которые необходимо сохранить.
Скопировал макрос, но получаю ошибку - Диапазоны копирования и вставки разного размера
Что я делаю не так?
И как исправить?
Спасибо!
Натолкнулся на аналогичную ошибку. Готов показать файл и прокомментировать действия. Как лучше это сделать?
Набросал свой макрос ориентируясь на ваш. Проблем в тестовой работе нет, как всегда спасибо. Отлично копирует из видимых отфильтрованных в видимые отфильтрованные и данные и формулы. Но:
Один вопрос к вам как к профессионалу: как поведет себя макрос в боевом режиме при многопользовательском доступе файлу и одновременной работе нескольких пользователей, где каждый пользователь работает с данными, активно их фильтрует и пр. Не наломает ли он дров?
Спасибо.
Код:
Dim originalRange As Range, targetRange As Range
Dim cell As Range, i As Long
title = "Paste values"
On Error GoTo errMyErrorHandler
Call GetRanges(title, originalRange, targetRange)
On Error GoTo 0
If targetRange.Cells.Count <> originalRange.Cells.Count Then
MsgBox "Äèàïàçîíû êîïèðîâàíèÿ è âñòàâêè ðàçíîãî ðàçìåðà!", vbCritical
Exit Sub
End If
For Each cell In targetRange
If cell.EntireRow.Hidden = False Then
cell.Value = Cells(cell.Row, originalRange.Column).Value
End If
Next cell
Exit Sub
errMyErrorHandler:
MsgBox Err.Description, vbExclamation + vbOKCancel, "Error: " & CStr(Err.Number)
Err.Clear
End Sub
Sub PasteFormulasToVisible()
Dim originalRange As Range, targetRange As Range
Dim cell As Range, i As Long
title = "Paste formulas"
On Error GoTo errMyErrorHandler
Call GetRanges(title, originalRange, targetRange)
On Error GoTo 0
If targetRange.Cells.Count <> originalRange.Cells.Count Then
MsgBox "Äèàïàçîíû êîïèðîâàíèÿ è âñòàâêè ðàçíîãî ðàçìåðà!", vbCritical
Exit Sub
End If
For Each cell In targetRange
If cell.EntireRow.Hidden = False Then
cell.Formula = Cells(cell.Row, originalRange.Column).Formula
End If
Next cell
Exit Sub
errMyErrorHandler:
MsgBox Err.Description, vbExclamation + vbOKCancel, "Error: " & CStr(Err.Number)
Err.Clear
'Resume Next
End Sub
Sub GetRanges(ByVal title As String, originalRange As Range, targetRange As Range)
Set originalRange = Application.InputBox("Source range", title, Type:=8, Default:=Selection.Address)
Set targetRange = Application.InputBox("Target range", title, Type:=8, Default:=originalRange.Address)
End Sub
А насчет многопользовательского режима могу сказать одно - никаких гарантий, надо пробовать на месте. Чем больше человеческого фактора, тем "веселее".
cell.Font.Color = copyrng.Cells(i).Font.Color 'для копирования цвета текста
ширина и высота ячейки
Cells(1, 2).ColumnWidth
Cells(1, 2).RowHeight
цвет фона
Cells(1, 2).Interior.Color
тип линии, толщина и ее цвет в обрамлении ячейки
Cells(1, 2).Borders(xlEdgeBottom).LineStyle
Cells(1, 2).Borders(xlEdgeBottom).Weight
Cells(1, 2).Borders(xlEdgeBottom).Color
здесь xlEdgeBottom - для нижней граници, xlEdgeRight - будет для права, xlEdgeLeft - лево xlEdgeTop- верх.
название шрифта
Cells(1, 2).Font.Name
размер
Cells(1, 2).Font.Size
цвет
Cells(1, 2).Font.ColorIndex
жирность .Bold, курсив .Italic
Подскажите как исправить, чтобы по нажатию Esc (либо "Отмена") - макрос завершался до конца (где у меня идёт исполнение процедуры защиты)
Николай, а мне макрос не помог. Каждый раз выдаёт ошибку - диапазоны копирования и вставки разного размера!
Делаю следующим образом: отфильтровываю данные для копирования, жму макрос "PasteToVisible", выбираю диапазон для копирования видимых ячеек, выбирают диапазон для вставки видимых ячеек. По форматированию, количеству видимых ячеек данные идентичные. Ошибка.
Чтобы добиться нужного результата делаю следующим образом: отфильтровываю данные для копирования, выделяю видимый диапазон, копирую на новый лист. Жму макрос "PasteToVisible" выбираю диапазон для копирования с нового листа, выбираю диапазон для вставки видимых ячеек на листе с исходными данными. Срабатывает!
А можно подкорректировать макрос, чтобы копировать диапазон видимых данных и вставлять в диапазон видимых ячеек?
Как быть в таком случае?
Улучшенная версия этого макроса есть, кстати, еще в PLEX
Подскажите пожалуйста, при запуске макроса выдает ошибку Syntax error что делать? в чем причина?
09.07.2014 17:04:54
Если его строку cell.Value = Cells(cell.Row, copyrng.Column).Value заменить на cell.Value = Cells(cell.Row, copyrng.Column).FormulaR1C1
То макрос будет копировать формулы и осуществлять смещение по относительным ссылка
Ему не нужны конкретные диапазоны. Сажаете на горячие клавиши Ctrl+Shift+С и после фильтрации просто выделяете нужный (отфильтрованный) диапазон и нажимаете горячие клавиши. Эксель попросит указать первую ячейку, куда надо вставить данные. Всё!
Макрос для значений:
Sub Скопировать_ЗНАЧЕНИЯ_в_отфильтрованных_ячейках() Set SourceRange = Selection Set pasterng = Application.InputBox("Выберите первую ячейку для вставки", "Куда вставить?", Type:=8) cntRows = SourceRange.Rows.Count For i = 0 To cntRows Set cell = pasterng.Offset(i, 0) If cell.EntireRow.Hidden = False Then cell.Value = Cells(cell.Row, SourceRange.Column).Value End If Next i End SubSub Скопировать_ФОРМУЛЫ_в_отфильтрованных_ячейках() Set SourceRange = Selection Set pasterng = Application.InputBox("Выберите первую ячейку для вставки", "Куда вставить?", Type:=8) cntRows = SourceRange.Rows.Count For i = 0 To cntRows Set cell = pasterng.Offset(i, 0) If cell.EntireRow.Hidden = False Then cell.Value = Cells(cell.Row, SourceRange.Column).Formula End If Next i End Subв чём проблема может быть?
Почему я 3 дня спокойно копировал в отфильтрованные ячейки и информация в скрытые ячейки не вставлялась, а на четвертый день ексель начал вставлять в отфильтрованные (скрытые) ячейки?
1. Фильтруем, в первую ячейку вводим данные
2. Стоя на ячейке, нажимаем Ctrl + C, ячейка выделяется подвижным пунктиром
3. Далее выделяем оставшиеся ячейки столбца. Лично мне удобно для скорости встать на последнюю ячейку столбца, зажать Shift и с помощью бегунка вернуться в начало столбца и нажать на ячейку, которая под копируемой. В результате выделяется весь столбец.
4. Нажимает Enter. Всё скопировалось.
P.S. А вот как советует Николай в сообщении 19.04.2013 21:52:52, сколько ни пробовали, не получилось.
1) Фильтруем данные.
2) Далее через ИНДЕКС + ПОИСКПОЗ находим значения, которые требуется подставить из соседнего списка ( либо ВПР можно использовать).
3) Протягиваем (копируем) формулу по отфильтрованному диапазону. При этом формула скопируется только в отфильтрованные ячейки.
4) Далее отключаем фильтр и копируем весь столбец значений, в том числе и формулы которые были скопированы когда всё было отфильтровано.
5) Вставляем в этот же столбец значения - "специальная вставка" -" значения" ( введённые Вами формулы заменятся на значения)