Добрый день! Подскажите пожалуйста, как можно получить подобную сводную таблицу? Необходимо отфильтровать уникальные значения Д1-Д18( в ячейках D17:V69) - сделать их строками сводной таблицы Имена узлов(столбец С) - столбцами сводной таблицы И посчитать кол-во встречающихся элементов в таблице.
С помощью стандартной сводной таблицы не могу получить на выходе результат, который мне нужен.
Во вложении пример.
Добрый день! Подскажите пожалуйста, как можно получить подобную сводную таблицу? Необходимо отфильтровать уникальные значения Д1-Д18( в ячейках D17:V69) - сделать их строками сводной таблицы Имена узлов(столбец С) - столбцами сводной таблицы И посчитать кол-во встречающихся элементов в таблице.
С помощью стандартной сводной таблицы не могу получить на выходе результат, который мне нужен.
Serge_007, Сергей, спасибо. Но возникают вопросы- во всех примерах извлечение уникальных значений из столбца, а возможно ли из массива? У меня вообщем не получилось. А если делать уникальные для каждого столбца, потом уникальные для результатов по всем столбцам, вообщем кривая схема)
Serge_007, Сергей, спасибо. Но возникают вопросы- во всех примерах извлечение уникальных значений из столбца, а возможно ли из массива? У меня вообщем не получилось. А если делать уникальные для каждого столбца, потом уникальные для результатов по всем столбцам, вообщем кривая схема)airwaves18244
Serge_007, Нашел пример отбора уникальных значений через макрос. Во вложении пример. Но он тоже по столбцу. Возможно ли его отредактировать для отбора уникальных из массива не знаю?
Serge_007, Нашел пример отбора уникальных значений через макрос. Во вложении пример. Но он тоже по столбцу. Возможно ли его отредактировать для отбора уникальных из массива не знаю? airwaves18244
Sub Extract_Unique() Dim vItem, avArr, li As Long ReDim avArr(1 To Rows.Count, 1 To 1) With New Collection On Error Resume Next For Each vItem In Range([b]"A2", Cells(Rows.Count, 2[/b]).End(xlUp)).Value 'Cells(Rows.Count, 1).End(xlUp) .Add vItem, CStr(vItem) If Err = 0 Then li = li + 1: avArr(li, 1) = vItem Else: Err.Clear End If Next End With If li Then [E2].Resize(li).Value = avArr End Sub
Sub Extract_Unique() Dim vItem, avArr, li As Long ReDim avArr(1 To Rows.Count, 1 To 1) With New Collection On Error Resume Next For Each vItem In Range([b]"A2", Cells(Rows.Count, 2[/b]).End(xlUp)).Value 'Cells(Rows.Count, 1).End(xlUp) .Add vItem, CStr(vItem) If Err = 0 Then li = li + 1: avArr(li, 1) = vItem Else: Err.Clear End If Next End With If li Then [E2].Resize(li).Value = avArr End Sub
Она выводит уникальные значения из массива транспонируя их в столбец. А как вывести в строку?
[admin]airwaves18244, оформляйте коды тегами![/admin] [vba]
Код
Sub Уникальные_выделение_2D() Dim i As Long, j As Long Dim Rng As Range, Sel As Range Dim arr Dim Uniq As Object Set Rng = Application.InputBox(prompt:="Выделите диапазон для поиска уникальных", Type:=8) Set Sel = Application.InputBox(prompt:="Выделите ячейку для вывода данных", Type:=8) Set Uniq = CreateObject("scripting.dictionary") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual arr = Rng.Value For i = 1 To UBound(arr) For j = 1 To UBound(arr, 2) If Len(arr(i, j)) > 0 Then If Not Uniq.Exists(arr(i, j)) Then Uniq.Add arr(i, j), 0 End If End If Next Next [Sel].Cells.Resize(Uniq.Count) = Application.Transpose(Uniq.keys) set Rng = Nothing: Set arr = Nothing: Set Sel = Nothing: Set Uniq = Nothing Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
[/vba]
Serge_007, Сергей можете подсказать по строке в макросе?
Она выводит уникальные значения из массива транспонируя их в столбец. А как вывести в строку?
[admin]airwaves18244, оформляйте коды тегами![/admin] [vba]
Код
Sub Уникальные_выделение_2D() Dim i As Long, j As Long Dim Rng As Range, Sel As Range Dim arr Dim Uniq As Object Set Rng = Application.InputBox(prompt:="Выделите диапазон для поиска уникальных", Type:=8) Set Sel = Application.InputBox(prompt:="Выделите ячейку для вывода данных", Type:=8) Set Uniq = CreateObject("scripting.dictionary") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual arr = Rng.Value For i = 1 To UBound(arr) For j = 1 To UBound(arr, 2) If Len(arr(i, j)) > 0 Then If Not Uniq.Exists(arr(i, j)) Then Uniq.Add arr(i, j), 0 End If End If Next Next [Sel].Cells.Resize(Uniq.Count) = Application.Transpose(Uniq.keys) set Rng = Nothing: Set arr = Nothing: Set Sel = Nothing: Set Uniq = Nothing Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
Всем добрый день! Подскажите пожалуйста, почему может возникать ошибка в макросе примера при транспонировании столбца Z10:Z14 в строку в ячейке AB9 через специальную вставку?
Из макроса примера, строки по транспонированию:
[vba]
Код
Set RngSortU = Range("Z10", Cells(Rows.Count, 26).End(xlUp))
ActiveWorkbook.Worksheets("Summary").Sort.SortFields.clear ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add Key:=RngSortU, _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Summary").Sort .SetRange RngSortU .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With
Всем добрый день! Подскажите пожалуйста, почему может возникать ошибка в макросе примера при транспонировании столбца Z10:Z14 в строку в ячейке AB9 через специальную вставку?
Из макроса примера, строки по транспонированию:
[vba]
Код
Set RngSortU = Range("Z10", Cells(Rows.Count, 26).End(xlUp))
ActiveWorkbook.Worksheets("Summary").Sort.SortFields.clear ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add Key:=RngSortU, _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Summary").Sort .SetRange RngSortU .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With
RAN, Пробовал) Проблема в том, что то вставляется, то нет. В чем подвох не понятно. Изменил таблицу, вставляется (см. пример). Чертовщина))
RAN, Пробовал) Проблема в том, что то вставляется, то нет. В чем подвох не понятно. Изменил таблицу, вставляется (см. пример). Чертовщина))airwaves18244
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
