Блог

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

Я провел исследование и нашел несколько сценариев VBA для этого, но это приводит к отсутствию данных, когда я выполняю подсчеты, чтобы подтвердить правильность поворота, и в итоге снова и снова добавляются повторяющиеся столбцы (имя / год рейтинга).

У кого-нибудь есть идеи? Я бы сделал сводную таблицу, но я не могу отобразить фактические значения рейтинга в сводной таблице, только сумму / количество / среднее значение и т. Д…

Вы можете легко сделать это в powerquery.

1. Выделите все ваши данные, затем вставьте> добавить таблицу
2. вкладка «Данные»> «Получить данные из таблицы»
3. выделите два правых столбца> сводные столбцы
4. уровень оценки как значения
5. дополнительные параметры> не агрегировать
6. найдите и замените null на nothing
7. сохраните и закройте

Сводные данные

Код

 Option Explicit

Sub pivotData()
    
    ' Define Source Range.
    Dim rng As Range
    Set rng = Range("A1").CurrentRegion
    
    ' Get unique values.
    Dim prs As Variant
    prs = getUniqueColumn1D(rng.Columns(1).Resize(rng.Rows.Count - 1).Offset(1))
    Dim yrs As Variant
    yrs = getUniqueColumn1D(rng.Columns(2).Resize(rng.Rows.Count - 1).Offset(1))
    sort1D yrs
    
    ' Source Range to Source Array.
    Dim Source As Variant
    Source = rng.Value
    
    ' Define Target Array.
    Dim Target As Variant
    ReDim Target(1 To UBound(prs) - LBound(prs)   2, _
                 1 To UBound(yrs) - LBound(yrs)   2)
    
    ' Write from arrays to Target Array.
    Target(1, 1) = Source(1, 1)
    Dim n As Long
    Dim i As Long
    i = 1
    For n = LBound(prs) To UBound(prs)
        i = i   1
        Target(i, 1) = prs(n)
    Next n
    Dim j As Long
    j = 1
    For n = LBound(yrs) To UBound(yrs)
        j = j   1
        Target(1, j) = yrs(n)
    Next n
    For n = 2 To UBound(Source, 1)
        i = Application.Match(Source(n, 1), prs, 0)   1
        j = Application.Match(Source(n, 2), yrs, 0)   1
        Target(i, j) = Source(n, 3)
    Next n
            
    ' Define Target Range.
    Set rng = Range("E1").Resize(UBound(Target, 1), UBound(Target, 2))
    
    ' Write from Target Array to Target Range.
    rng.Value = Target
            
    ' Inform user.
    MsgBox "Data transferred.", vbInformation, "Success"
    
End Sub

' Returns the unique values from a column range.
Function getUniqueColumn1D(ColumnRange As Range, _
                           Optional ByVal Sorted As Boolean = False) _
         As Variant
    Dim Data As Variant
    Data = ColumnRange.Columns(1).Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        Dim Key As Variant
        Dim i As Long
        For i = 1 To UBound(Data, 1)
            Key = Data(i, 1)
            If Not IsError(Key) And Not IsEmpty(Key) Then
                .Item(Key) = Empty
            End If
        Next i
        If .Count > 0 Then
            getUniqueColumn1D = .Keys
        End If
    End With
End Function

' Sorts a 1D array only if it contains values of the same data type.
Sub sort1D(ByRef OneD As Variant, _
           Optional ByVal Descending As Boolean = False)
    With CreateObject("System.Collections.ArrayList")
        Dim i As Long
        For i = LBound(OneD) To UBound(OneD)
            .Add OneD(i)
        Next i
        .Sort
        If Descending Then
            .Reverse
        End If
        OneD = .ToArray
    End With
End Sub