如何将重复的行转为列？

Question

很难弄清楚如何将具有重复行的多列数据集转换为唯一列。

我进行了研究并找到了一些 VBA 脚本来执行此操作，但是当我进行计数以确认它正确旋转并最终一遍又一遍地添加重复的列（名称/评级年份）时，它会导致数据丢失。

有人有什么想法吗？我会做一个数据透视表，但我无法在数据透视表中显示实际评级值，只能显示总和/计数/平均值。等等……

Answer 1

您可以在 powerquery 中轻松完成此操作。

1. 突出显示所有数据，然后插入>添加表格
2. 数据选项卡>从表中获取数据
3. 突出显示右侧两列>枢轴列
4. 将等级作为值
5. 高级选项>不要聚合
6. 查找 null 并将其替换为空
7. 保存并关闭

Answer 2

透视数据

守则

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