Andron155, написала макрос, можете проверять. Если результирующие колонки нужно будет поменять, в строчках с комментами поставьте нужные названия / номера колонок. Макрос вывода уникальных строк
[vba]
Код
Sub OutUniqueVal() Dim a(), b(), i& With Sheets(1).UsedRange a = .Columns(1).Resize(, 3).Value End With For i = 1 To UBound(a) ReDim Preserve b(i) b(i) = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) Next i = 1 For Each v In UniqueValues(b) result = Split(v, "|") For j = 0 To UBound(result): Cells(i, 6 + j) = result(j): Next j 'Вывод результата (начиная с 6-й колонки) i = i + 1 Next End Sub
[/vba]
Функция, извлекающая уникльные значения из массива
[vba]
Код
Function UniqueValues(ByVal arr) As Collection Set UniqueValues = New Collection: On Error Resume Next For Each v In arr v = Trim(v): If Len(v) Then UniqueValues.Add CStr(v), CStr(v) Next v End Function
[/vba]
Вызов макроса при изменении листа (в модуле листа1)
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column < 4 Then Application.ScreenUpdating = False Columns("F:H").ClearContents 'Удалить предыдущий результат OutUniqueVal Application.ScreenUpdating = True End If End Sub
[/vba]
Andron155, написала макрос, можете проверять. Если результирующие колонки нужно будет поменять, в строчках с комментами поставьте нужные названия / номера колонок. Макрос вывода уникальных строк
[vba]
Код
Sub OutUniqueVal() Dim a(), b(), i& With Sheets(1).UsedRange a = .Columns(1).Resize(, 3).Value End With For i = 1 To UBound(a) ReDim Preserve b(i) b(i) = a(i, 1) & "|" & a(i, 2) & "|" & a(i, 3) Next i = 1 For Each v In UniqueValues(b) result = Split(v, "|") For j = 0 To UBound(result): Cells(i, 6 + j) = result(j): Next j 'Вывод результата (начиная с 6-й колонки) i = i + 1 Next End Sub
[/vba]
Функция, извлекающая уникльные значения из массива
[vba]
Код
Function UniqueValues(ByVal arr) As Collection Set UniqueValues = New Collection: On Error Resume Next For Each v In arr v = Trim(v): If Len(v) Then UniqueValues.Add CStr(v), CStr(v) Next v End Function
[/vba]
Вызов макроса при изменении листа (в модуле листа1)
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column < 4 Then Application.ScreenUpdating = False Columns("F:H").ClearContents 'Удалить предыдущий результат OutUniqueVal Application.ScreenUpdating = True End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
