Страницы: 1
RSS
Уникальные значения с нескольких столбцов в один столбец
 
Здравствуйте уважаемые форумчане.

Работаю с большим кол-вом данных (версия Excel 2021), необходимо решить задачу:
В прикрепленном файле в столбце "Результат" собран список уникальных значений из предыдущих 6-ти столбцов,
формулами типа: ввести в G2

=ЕСЛИОШИБКА(ИНДЕКС($A$2:$F$10000;ОКРВНИЗ((МАКС((СЧЁТЕСЛИ($G$1:G1;$A$2:$F$10000)=0)*((СТРОКА($A$2:$F$10000)-2)*6+СТОЛБЕЦ($A$2:$F$10000)))-1)/6;1)+1;(ОСТАТ(МАКС((СЧЁТЕСЛИ($G$1:G1;$A$2:$F$10000)=0)*((СТРОКА($A$2:$F$10000)-2)*6+СТОЛБЕЦ($A$2:$F$10000)))-1;6)+1));"") или подобные ей

задачу решить не помогут, т.к. кол-во столбцов может быть много, строк более 10000, таблица начинает сильно тормозить, данные в первых 6-ти столбцах, как в примере, будут меняться автоматически и хотелось бы найти возможно макрос-функцию или простую формулу как типа "=УНИК" но чтоб работала на много столбцов, для получения автоматического единого уникального списка в одном столбце (а в идеале еще и чтоб в ней была встроена при необходимости функция "=СОРТ", ну если возможно :) )

Так же читал про функцию "=TOCOL", но в моей лицензированной версии Excel 2021 ее тоже нет, но есть приобретенный PLEX. Еще задавал вопрос в чат Джи Пи Ти, на что был получен ответ: ввести в G1 формулу: "=UNIQUE(FILTER({A:A; B:B; C:C; D:D; E:E; F:F}, {A:A; B:B; C:C; D:D; E:E; F:F}<>""))", конечно поменял эту формулу на "=УНИК(ФИЛЬТР....". менял запятые на точки с запятыми, пробовал вставлять точки с запятыми перед знаками <>  - формула не работает.
Может кто подскажет как решить данный вопрос (можно прямо в моем примере  :) ), за ранее благодарю.
Изменено: Максим Кухальский - 10.06.2024 03:49:37
 
Добрый день сделал запрос через Power Query. Если в именованный диапазон листа 1 добавить ваши данные и нажать кнопку обновить, листа "Результат", то уникальный данные со всех столбцов появится в столбце "результат" .
 
Для Вашего примера
Скрытый текст

Ограничения:
1. Последняя строка с данными определяется по столбцу A
2. Диапазон исходных столбцов должен быть непрерывным
Цитата
Максим Кухальский написал:
для получения автоматического единого уникального списка в одном столбце.
Макрос можно 'повесить' на нужное событие.
Согласие есть продукт при полном непротивлении сторон
 
nissanpassan, спасибо Вам большое, но немного не то, нужен автоматический список, т.к. у меня умный калькулятор, без нажатия обновить
 
Sanja, Спасибо, а можно его повесить допустим когда вносится любое изменение в книге на любом листе? или это сильно затормозит файл, если нет, может подскажете строчку?
Изменено: Максим Кухальский - 10.06.2024 04:02:33
 
Сделал себе подсказки
 
Цитата
Максим Кухальский написал:
когда вносится любое изменение в книге на любом листе
Вы сами этого хотели)
В модуль ЭтаКнига
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
  Call AllUnique
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
ОГОНЬ, попробую теперь на калькуляторе, СПАСИБО ВАМ ОГРОМНОЕ :D  
Изменено: Максим Кухальский - 10.06.2024 04:13:18
 
Sanja, Добавил еще одну функцию в модуль, т.к. при изменении данных в 6-столбцах по кол-ву строк в меньшую сторону, старые данные не удаляются, а остаются:

Sub Удаление_столбца_уникальных()
   Columns("I:I").Select
   Selection.ClearContents
End Sub

Потом дописал в Ваш код, в модуль ЭтаКнига

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Call Удаление_столбца_уникальных
 Call AllUnique
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Вот только как дописать, чтоб завершенным действием было такое чтоб, выделенная ячейка оставалась там, где было внесено последнее изменение перед запуском этого макроса?)) или можно попроще что придумать?
 
Допилил:

Сначала она очищает столбец с результатами, потом закидывает уникальные, если в книге есть еще листы и вы будете на них, то можно дописать в конце
Sheets("Нужный лист").Select
Range("нужная ячейка").Select

А затея "при любом изменении в книге" запускать данный макрос была плохая идея, нужно выбрать подходящее событие. полный код:

Sub AllUnique()
Sheets("Лист1").Select 'переключаемся на нужный лист
Columns("I:I").Select ' выделяем столбец с результатами
   Selection.ClearContents 'очищаем его
Dim arr()
Dim iKey, iTmp
With Worksheets("Лист1") ' Лист1 - вкладка где нужно искать уникальные
 arr = Range("A2:F" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value 'диапазон столбцов для выдергивания уникальных
End With
With CreateObject("Scripting.Dictionary")
 For Each iKey In arr
   If Not IsEmpty(iKey) Then iTmp = .Item(iKey)
 Next
Worksheets("Лист1").Range("I2").Resize(.Count) = Application.Transpose(.Keys) ' адрес результата
End With
Sheets("Лист1").Select 'переключаемся на выбранный лист
Range("G1").Select 'ну и к примеру выделяем нужную ячейку
End Sub

Еще раз огромное спасибо, очень помогли, файл во вложении.
Страницы: 1
Наверх