Sub 右变左乱序字典()
    Range("B2").Resize(1000, 3).ClearContents
    arr = Range("G1").CurrentRegion
    Dim dic '分组1 去重

    Set dic = CreateObject("scripting.dictionary")
    Dim dic2 '分组1+分类
    Set dic2 = CreateObject("scripting.dictionary")
    
    For i = 2 To UBound(arr)
        Key = arr(i, 1) '分组1
        dic(Key) = ""
        key2 = Key & "#" & arr(i, 2) '分组1#分类
        dic2(key2) = dic2(key2) & arr(i, 3) '书名连接
    Next
    
    keys = dic.keys
    
    For i = 0 To dic.Count - 1
        Cells(i + 2, 2) = keys(i)
        Cells(i + 2, 3) = dic2(keys(i) & "#A")
        Cells(i + 2, 4) = dic2(keys(i) & "#B")
    Next
End Sub