Поделите Екцел лист у више датотека на основу колоне помоћу ВБА

Имате ли велике податке на Екцел листу и морате их распоредити у више листова, на основу неких података у колони? Ово је врло основни задатак, али одузима много времена.

На пример, ја имам ове податке. Ови подаци имају колону под називом Датум, писац и Титле. Колона писац има име писца одговарајућег наслова. Желим да податке сваког писца унесем у засебне листове.

Да бих то урадио ручно, морам да урадим следеће:

Филтрирајте једно име
Копирајте филтриране податке
Додајте лист
Залепите податке
Преименујте лист
Поновите свих горе наведених 5 корака за сваки.

У овом примеру имам само три имена. Замислите да имате 100 имена. Како бисте поделили податке на различите листове? Биће потребно много времена, а и вас ће исцрпити.
Да бисте аутоматизовали горњи процес цепања листа на више листова, следите ове кораке.

Притисните Алт+Ф11. Ово ће отворити ВБ Едитор за Екцел
Додајте нови модул
Копирајте испод кода у модулу.

 Суб СплитИнтоСхеетс () Витх Апплицатион .СцреенУпдатинг = Фалсе .ДисплаиАлертс = Фалсе Енд Витх ТхисВоркбоок.Ацтивате Схеет1.Ацтивате 'цлеаринг филтер иф ани Он Еррор Ресуме Нект Схеет1.СховАллДата Он Еррор ГоТо 0 Дим лсрЦлм Ас Лонг Дим лстРов Ас Лонг' бројање последњег коришћеног реда лстРов = Целлс (Ровс.Цоунт, 1) .Енд (клУп) .Ров Дим уникуес Ас Ранге Дим цлм Ас Стринг, цлмНо Ас Лонг Он Еррор ГоТо хандлер цлм = Апплицатион.ИнпутБок ("Из које колоне желите да креирате датотеке" & вбЦрЛф & "Нпр. А, Б, Ц, АБ, ЗА итд " уникуес = РемовеДуплицатес (уникуес) Позовите ЦреатеСхеетс (уникуес, цлмНо) Витх Апплицатион .СцреенУпдатинг = Труе .ДисплаиАлертс = Труе .АлертБефореОвервритинг = Труе .Цалцулатион = клЦалцулатионАутоматиц Енд Витх Схеет1.Ацтивате МсгБок "Добро обављено!" Излаз из обраде под података.СховАллДата: Са апликацијом .СцреенУпдатинг = Труе .ДисплаиАлертс = Труе .АлертБефореОвервритинг = Труе .Цалцулатион = клЦалцулатионАутоматиц Енд Витх Енд Суб Функција РемовеДуплицатес (јединствени као опсег) као опсег ТхисВоркбоок.Ацтивате Схеетс.Адд Он Еррор Ресуме Нект АцтивеСхеет.Наме = "уникуес" Схеетс ("уникуес"). Ацтивате Он Еррор ГоТо 0 уникуес.Цопи Целлс (2, 1) .Ацтивате АцтивеЦелл.ПастеСпециал клПастеВалуес Ранге ("А1") .Валуе = "уникуес" Дим лстРов Ас Лонг лстРов = Целлс (Ровс.Цоунт, 1) .Енд (клУп) .Рацх Ранге ("А2: А" & лстРов). Одаберите АцтивеСхеет.Ранге (Селецтион.Аддресс) .РемовеДуплицатес Цолумнс : = 1, Заглавље: = клНо лстРов = Ћелије (Ровс.Цоунт, 1) .Енд (клУп) .Ров Сет РемовеДуплицатес = Ранге ("А2: А" & лстРов) Крајња функција Суб ЦреатеСхеетс (јединствени Ас Ранге, цлмНо Ас Лонг) Дим лстЦлм Ас Лонг Дим лстРов Ас Лонг Фор еацх уникуе Ин уникуес Схеет1.Активирајте лстРов = Целлс (Ровс.Цоунт, 1) .Енд (клУп) .Ров лстЦлм = Целлс (1, Цолумнс.Цоунт) .Енд (клТоЛефт) .Цолумн Дим датаСет Ас Ранге Сет датаСет = Распон (ћелије (1, 1), ћелије (лстРов, лстЦлм)) поље датаСет.АутоФилтер: = цлмНо, Цритериа1: = уникуе.Валуе лстРов = Целлс (Ровс.Цоунт, 1) .Енд ( клУп) .Ров лстЦлм = Целлс (1, Цолумнс.Цоунт) .Енд (клТоЛефт) .Цолумн Дебуг.Принт лстРов; лстЦлм Сет датаСет = Опсег (ћелије (1, 1), ћелије (лстРов, лстЦлм)) датаСет.Цопи Схеетс.Адд АцтивеСхеет.Наме = уникуе.Валуе2 АцтивеЦелл.ПастеСпециал клПастеАлл Следећа јединствена завршна под

Када ћете трчати СплитИнтоСхеетс () процедура, лист ће бити подељен у више листова, на основу дате колоне. Можете додати дугме на лист и доделити му овај макро.

Како то ради
Горњи код има две процедуре и једну функцију. Два су поступка СплитИнтоСхеетс (), ЦреатеСхеетс (јединствени Ас Ранге, цлмНо Ас Лонг) а једна функција је РемовеДуплицатес (уникуес Ас Ранге) Ас Ранге.

Први поступак је СплитИнтоСхеетс (). Ово је главни поступак. Ова процедура поставља променљиве и РемовеДуплицатес да бисте добили јединствена имена из дате колоне и затим проследили та имена у ЦреатеСхеетс за израду листова.

РемовеДуплицатес узима један аргумент који је опсег који садржи име. Уклања дупликате од њих и враћа објекат опсега који садржи јединствена имена.

Сада ЦреатеСхеетс се зове. Потребна су два аргумента. Прво јединствена имена, а затим колона бр. из којих ћемо уклопити податке. Сада ЦреатеСхеетс узима свако име из јединствених и филтрира дати број колоне по сваком имену. Копира филтриране податке, додаје лист и тамо их залепи. Ваши подаци се деле у неколико листова у неколико секунди.

Овде можете преузети датотеку.
Поделите на листове

Како користити датотеку:

- Копирајте своје податке на Схеет1. Уверите се да почиње од А1.

- Кликните на дугме Подели у листове
- Унесите слово колоне из које желите да се одвојите. Притисните У реду.

- Видећете овакав упит. Ваш лист је подељен.

Надам се да вам је чланак о раздвајању података на засебне листове био од помоћи. Ако имате било каквих недоумица у вези са овом или било којом другом особином програма Екцел, слободно то питајте у одељку за коментаре испод.