Страницы: 1
RSS
Как делать сводную таблицу, где необходимо подсчитать данные по нескольким столбцам
 
Как сделать сводную таблицу, где названия строк будет браться из нескольких столбцов, а количество по уникальному идентификатору.
 
Пример
Для 2013 и младше
Согласие есть продукт при полном непротивлении сторон
 
UDF (вводится сразу в весь диапазон как формула массива)
Код
Function UNIQUE(rng As Range) As Variant
Dim tmpArray()
Dim tmpCol As New Collection
tmpArray = rng.Value
For I = LBound(tmpArray, 1) To UBound(tmpArray, 1)
    For J = 1 To rng.Columns.Count
        On Error Resume Next
        tmpCol.Add tmpArray(I, J), CStr(tmpArray(I, J))
    Next
Next
ReDim tmpArray(tmpCol.Count - 1, 1)
For I = 0 To tmpCol.Count - 1
    tmpArray(I, 0) = tmpCol(I + 1)
Next
UNIQUE = tmpArray
End Function
Изменено: Sanja - 07.10.2016 20:42:59
Согласие есть продукт при полном непротивлении сторон
 
Спасибо.
В понедельник испробую на большом объеме данных.
 
Вот здесь продолжение на основе Вашей темы
Согласие есть продукт при полном непротивлении сторон
 
Альтернативные варианты:
адаптировать пример #8 отсюда -
Код
Sub tt()
    Dim a(), el, D As Object
    a = Selection.Value
    Set D = CreateObject("Scripting.Dictionary"): D.comparemode = 1
        For Each el In a
            If Not D.EXISTS(el) Then
                D.Item(el) = 1
            Else
                D.Item(el) = D.Item(el) + 1
            End If
        Next
        
On Error Resume Next
Application.InputBox(Prompt:="Выделите ячейку для выгрузки результата:", Type:=8).Resize(D.Count, 2) = Application.Transpose(Array(D.keys, D.items))
On Error GoTo 0
End Sub
... пример #11 - тоже красивый, но завернуть SQL-конструкцию пока не смогла - недочёт получается по идентичным записям (4 и 122 - которые встречаются по одному разу в разных столбцах - поэтому и sql их идентифицирует, как одну и ту же запись по идентификатору-количеству, которые идентичны)
Скрытый текст
хотя если взять код #12 (через HashTable) или #11 (через SQL) "as is" и рядом просчитать кол-во по формуле СЧЁТЕСЛИ (как в примере от Sanja) - то тоже будет результат
p.s.
примеры работают на выделенном диапазоне... или в код подставьте нужный диапазон
Изменено: JeyCi - 09.10.2016 15:48:42
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
Sanja, Просьба пояснить как это работает.
Не получается увеличить объем данных.
 
Я не разобрался в рекомендуемом методе Sanja (слабоват в макросах), но вашу задачу решил следующим образом: преобразовал ваши данные в "плоскую таблицу" с помощью макроса Павлова Николая:
Код
Sub Redesigner()

    ' макрос для преобразования таблицы из иерархии в плоскую
    
    Dim i As Long
    Dim hc As Integer, hr As Integer
    Dim ns As Worksheet
   
    
    hr = InputBox("Сколько строк с подписями сверху?")
    hc = InputBox("Сколько столбцов с подписями слева?")
     
    Application.ScreenUpdating = False
     
    i = 1
    Set inpdata = Selection
    Set ns = Worksheets.Add
     
    For r = (hr + 1) To inpdata.Rows.Count
        For c = (hc + 1) To inpdata.Columns.Count
            For j = 1 To hc
                ns.Cells(i, j) = inpdata.Cells(r, j)
            Next j
             
            For k = 1 To hr
                ns.Cells(i, j + k - 1) = inpdata.Cells(k, c)
            Next k
             
            ns.Cells(i, j + k - 1) = inpdata.Cells(r, c)
            i = i + 1
        Next c
    Next r
End Sub

Затем уже создал сводную таблицу по вашим параметрам.
 
Vladimir Chebykin, С Вашим файлом все понятно.
Страницы: 1
Наверх