сбор уникальных всех названий из списка по одному названию больше 20000 наименований vba бес формул

RSS

сбор уникальных всех названий из списка по одному названию больше 20000 наименований vba бес формул, сбор уникальных всех названий из списка по одному названию больше 20000 наименований vba бес формул

dxf

Пользователь

Сообщений: 156 Регистрация: 10.12.2018

15.09.2022 22:27:03

доброго времени суток , как можно заменить формулу на макрос вба, дело в том что очень большое количество формул очень тормозят эксель и список очень большой приходится разбивать на части до 20000 и ждать по пол часа пока про цедура не закончится, к формуле вопросов нет , работает точно , искал в интернете похожее не нашол копировал кода эсперементировал решил написать на форум . дело в том ч то кодом vba реально заменить формулу, по данному примеру в книге?

Прикрепленные файлы

а1а1.xlsx (12.49 КБ)

New Пользователь Сообщений: 4837 Регистрация: 06.01.2013	#2 15.09.2022 22:33:08 OFF. Кровь из глаз - бес, нашол, эсперементировал, счот, масив

Hugo Пользователь Сообщений: 23795 Регистрация: 22.12.2012	#3 15.09.2022 22:39:07 Просто вручную удалить дубликаты чем не вариант?

dxf Пользователь Сообщений: 156 Регистрация: 10.12.2018	#4 15.09.2022 22:40:45 мне не надо удалять нужно цэлый список и уникальные названия из списка, в файле примере формулы есть , по принцыпу можно сделать в vba? Изменено: dxf - 15.09.2022 22:49:34

New Пользователь Сообщений: 4837 Регистрация: 06.01.2013	#5 15.09.2022 22:49:00 вот так? см. файл Прикрепленные файлы а1а1.xlsm (19.92 КБ)

dxf Пользователь Сообщений: 156 Регистрация: 10.12.2018	#6 15.09.2022 22:53:28 да то что нужно !!!!!!!!!!!!!!! огромное спасибо!!!!!!!!!!!!!!!!!!!

БМВ

Модератор

Сообщений: 23279 Регистрация: 28.12.2016

Excel 2013, 2016

16.09.2022 10:11:57

расширенный фильтр, без всяких формул и критериев с результатом на другой диапазон и выводом уникальных.
Или тоже но макросом

Код

    With ActiveSheet
    .Range("D:D").ClearContents
    .Range("E1") = .Range("b1")
    .Range("E2") = "<>"
    .Range("B:B").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=.Range("E1:E2"), _
    CopyToRange:=.Range("D1"), Unique:=True
    .Range("D1") = "ÎÒÁÎÐ ÍÀÇÂÀÍÈÉ ÏÎ ÎÄÍÎÌÓ ÑÎ ÑÏÈÑÊÀ"
    .Range("e1:e2").ClearContents
    End With

Изменено: БМВ - 16.09.2022 10:30:36

По вопросам из тем форума, личку не читаю.

dxf

Пользователь

Сообщений: 156 Регистрация: 10.12.2018

16.09.2022 15:29:59

спасибо за код но он не работает я попробовал запустить я так понял пробелы мешают
With ActiveSheet .Range("D:D").ClearContents
.Range("E1") = .Range("b1")
.Range("E2") = "<>"
.Range("B:B").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("E1:E2"), _
CopyToRange:=.Range("D1"), Unique:=True
.Range("D1") = "ÎÒÁÎÐ ÍÀÇÂÀÍÈÉ ÏÎ ÎÄÍÎÌÓ ÑÎ ÑÏÈÑÊÀ"
.Range("e1:e2").ClearContents
End With

New сделал то что нужно,

БМВ Модератор Сообщений: 23279 Регистрация: 28.12.2016 Excel 2013, 2016	#9 16.09.2022 17:32:36 хорошему ~~танцору~~ прогеру пробелы не мешают :-) Все работает. Прикрепленные файлы example2711.xlsm (30.14 КБ) По вопросам из тем форума, личку не читаю.

dxf Пользователь Сообщений: 156 Регистрация: 10.12.2018	#10 17.09.2022 23:32:00 Спасибо работает один вариант можно решить многими способами если знаешь где нужно подправить или переписать, супер, чего не скажешь про меня, если-б было всё просто , отлично что есть сайт и много умных людей. которые помогают решить поставленые задачи и этим доказывают что ексель можно применить в многих отраслях даже туда где он не предназначен изначально. Но, как показывает практика это реально.