Иногда эксель удивляет своими требованиями делать что-то через э… макросы. Вот недавно, встала задача разбить несколько объединенных ячеек по одной, чтобы можно было нормально отсортировать весь диапазон. Думаю, никому не надо объяснять, как просто убрать объединение ячеек, разбив их по одной (я имею ввиду формат-выравнивание-убрать галку с “объединение ячеек”). Но, к сожалению, эксель обладает очень интересным свойством при отмене объединения ячеек не спрашивать, как именно мы хотели бы их вернуть в нормальное, разъединенное состояние, а тупо пишет в верхнюю левую ячейку значение, которое было в объединенной, а все остальные ячейки оставляет незаполненными. Ну, естественно, ни о какой нормальной сортировке по прежде объединенным ячейкам говорить не приходится. И хорошо бы их было всего штук 200-300. А если их шестьдесят тысяч, разбитых на группы по 10 ячеек? Вручную шесть тысяч значений потом копировать в оставшиеся пустыми ячейки?
Типичная картина – хотим отсортировать список пофамильно, чтобы Кузнецов шел все-таки после Иванова. Пример, разумеется, очень упрощенный.
Просто так отсортировать таблицу эксель нам не даст – ячейки-то объеденены. Но и если мы отменим объединение, то каждая фамилия запишется только в верхнюю ячейку, и остальные придется дозаполнять. Получится вот так вот:
А нам то надо, чтобы в каждой ячейке было соответствующее значение, иначе при сортировке получится черти что!
К сожалению, выполнить это стандартными средствами экселя, как например, мы удаляли дубли или картинки – невозможно. Необходимо использовать макросы. Но, слава богу, есть добрые люди на свете, которые уже сделали это до нас. Причем – написали даже не один макрос, а целых несколько. При этом макросы позволяют не только разделять ячейки с сохранением содержащейся в них информации, но и многое другое:
- разбитие ячеек с автозаполнением
- более подробно о снятии объединения ячеек с заполнением
- разгруппировать ячейки выделенного диапазона с заполнением
Проверил все, работают отлично. Код самого простого, как показавшего отличнейшие результаты, хочу разместить и здесь. На всякий случай, если вдруг пропадет с исходной страницы, ссылку на которую я привел выше.
Итак, создаем макрос с кодом:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Sub UnMerge_And_Fill_By_Value() ' разгруппировать все ячейки в Selection и ячейки каждой бывшей группы заполнить значениями из их первых ячеек Dim Address As String Dim Cell As Range If TypeName(Selection) <> "Range" Then Exit Sub End If If Selection.Cells.Count = 1 Then Exit Sub End If Application.ScreenUpdating = False For Each Cell In Intersect(Selection, ActiveSheet.UsedRange).Cells If Cell.MergeCells Then Address = Cell.MergeArea.Address Cell.UnMerge Range(Address).Value = Cell.Value End If Next End Sub |
В результате выполнения макроса все выделенные объединенные ячейки разбиваются по одной, и заполняются именно тем значением, которое было в объединенной. Сортируй-не хочу.
Только не надо забывать, что после выполнения макроса, отменить эту операцию нельзя. Поэтому лучше работать с копией таблицы.
Ну и если, уже после того, как ячейки будут пересортированы, потребуется снова объединить ячейки с одинаковыми значениями (забудем на минуту, что объединенные ячейки – это зло, т.к. в случае, если требуется визуальная наглядность – то без них не обойтись), то нам опять придется использовать макрос. В интернете ссылок куча – но у меня заработал только один.
Тоже на всякий случай приведу код:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
Sub MergeCls() Dim ri As Integer, r2 As Integer, Col As Integer r1 = ActiveCell.Row r2 = ActiveCell.Row Col = ActiveCell.Column Do If Cells(r1, Col) <> Cells(r2 + 1, Col) Then If r1 <> r2 Then Range(Cells(r1 + 1, Col), Cells(r2, Col)).ClearContents With Range(Cells(r1, Col), Cells(r2, Col)) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With End If r1 = r2 + 1 End If r2 = r2 + 1 Loop Until Cells(r2, Col) = "" End Sub |
Все ячейки с одинаковыми значениями при его выполнении объединятся в соответствующие группы. Единственное – возможно, что форматирование толщины линий придется слегка подправить.
Спасибо Вам!!!!!!
Вопрос, я прописала макрос, но не пойму как их применять для других таблиц, или каждый раз создавать во вновь открывшемся файле с которым работаю, или как то сохранить можно эти макросы???? Подскажите плиз!! За ранее благодарю
Вариант 1 – создать какой-нибудь пустой файл, в котором создать этот макрос, сохранить. Сначала открывать этот файл, затем свой файл, с которым работаете, и выполнять там макрос, содержащийся в пустом файле (выбрав хранилище макросов – “все открытые книги”.
Вариант 2 – Поместить его в стандартный модуль Personal.xls (личная книга макросов).
Если этой книги у Вас ещё нет, то макрорекордером запишите любой макрос (потом удалите) и сохраните его в “личной книге макросов”. При этом действии она (книга) автоматически создастся.
Туда кладете до кучи и нужный макрос. После этого – идете в меню “окно”-“скрыть”, и убираете эту книгу с глаз, чтобы она их лишний раз не мозолила.
Обязательно попробую, завтра же!!! Спасибо!!! А вообще, хочу сказать, Вы большой умница!!! Неожиданно для меня очень помогли)))))
Огромное спасибо!!!
Такую сложную проблему благодаря вам решили за 5 мин. В базе было 16000 строк, сгруппированных по 3. Здорово!
Здравствуйте! Подскажите, пожалуйста, можно ли присвоить порядковый номер группе ячеек автоматически. Т.е. есть массив данных, состоящий из 1000 строк, эти строки надо разбить по 10 и пронумеровать. Первые 10 строк = 1, вторые 10=2 и т.п. Можно ли это сделать автоматически?
Передо мною такой задачи не стояло, а как ее решить с наскока – нет, не знаю.
СПАСИБО!!!!
Здравствуйте! Я только сталкнулся с такой проблемой я сделал кашу и сделал это… И это никогда не забудешь… Можете обращаться на ватсап 8702544445.