Имеется одна начальная таблица: Аргумент и Значение. Необходимо создать новую сводную таблицу, чтобы в графе "Аргумент" были данные без дубликатов, и им соответствовали значения (указанные через запятую) тоже без дубликатов. Например, имеется аргумент 1, который повторяется три раза, следовательно в сводной таблице должна быть одна запись. Данному аргументу соответствуют значения 123, 123 и 45, соотвественно нужно оставить только 123 и 45 и указать из в одной ячейке через запятую.
Имеется одна начальная таблица: Аргумент и Значение. Необходимо создать новую сводную таблицу, чтобы в графе "Аргумент" были данные без дубликатов, и им соответствовали значения (указанные через запятую) тоже без дубликатов. Например, имеется аргумент 1, который повторяется три раза, следовательно в сводной таблице должна быть одна запись. Данному аргументу соответствуют значения 123, 123 и 45, соотвественно нужно оставить только 123 и 45 и указать из в одной ячейке через запятую.Ученик01
Serge_007, но как раз стоит именно такая задача, чтобы все значения были в одной ячейке. Нашел следующий макрос (во вложении). Можете его настроить, чтобы в ячейку попадали именно уникальные значения, т.е. не было повторов?
Serge_007, но как раз стоит именно такая задача, чтобы все значения были в одной ячейке. Нашел следующий макрос (во вложении). Можете его настроить, чтобы в ячейку попадали именно уникальные значения, т.е. не было повторов?Ученик01
Sub Delim() Dim V As Range, Prev$, V2$ For Each V In Range(Sheets(1).[A2], Sheets(1).[A2].End(xlDown).Offset(1)) 'на 1 больше для цикла If V <> Prev And Len(V2) <> 0 Then Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1) = Prev 'ниже от первой Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = Mid(V2, 3) 'справа от предыдущей V2 = vbNullString End If Prev = V If InStr(V2, V.Offset(0, 1)) = 0 Then V2 = V2 & ", " & V.Offset(0, 1) 'ячейка справа Next End Sub
[/vba]
Немного подправлен ваш код. [vba]
Код
Sub Delim() Dim V As Range, Prev$, V2$ For Each V In Range(Sheets(1).[A2], Sheets(1).[A2].End(xlDown).Offset(1)) 'на 1 больше для цикла If V <> Prev And Len(V2) <> 0 Then Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1) = Prev 'ниже от первой Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = Mid(V2, 3) 'справа от предыдущей V2 = vbNullString End If Prev = V If InStr(V2, V.Offset(0, 1)) = 0 Then V2 = V2 & ", " & V.Offset(0, 1) 'ячейка справа Next End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
