怎么调整布局？

125675117

各位老师，用数据透视实现的结果不是自己想要的，想实现附件的样式布局，请帮助实现一下，谢谢。

于箱长

125675117

1. Sub 转置()
   
2. Dim Arr, Brr(), i, j, kk, n, nRow
   
3. Dim DicSs As Object: Set DicSs = CreateObject("scripting.dictionary")
   
4. Arr = [a1].CurrentRegion
   
5. For i = 2 To UBound(Arr)
   
6.     If Arr(i, 3) <> "" Then DicSs(Arr(i, 3)) = DicSs(Arr(i, 3)) + 1
   
7.     Next
   
8.     For Each kk In DicSs.keys
   
9.     ReDim Brr(1 To 2, 1 To DicSs(kk) + 1)
   
10. Brr(1, 1) = kk: n = 1
    
11. For i = 2 To UBound(Arr)
    
12. If Arr(i, 3) = kk Then
    
13. n = n + 1
    
14. Brr(1, n) = Arr(i, 1)
    
15. Brr(2, n) = Arr(i, 2)
    
16. End If
    
17. Next
    
18. nRow = [f1048576].End(3).Row + 1
    
19. Cells(nRow, 5).Resize(UBound(Brr), UBound(Brr, 2)) = Brr
    
20. Next
    
21. End Sub
    

复制代码

于箱长 发表于 2023-7-4 09:17

谢谢老师，好了。

ykcbf1100

行列转换。。。

125675117

ykcbf1100 发表于 2023-7-4 09:50
行列转换。。。

谢谢老师！！！！

于箱长

ykcbf1100 发表于 2023-7-4 09:50
行列转换。。。

老兄这字典嵌套玩儿得是真溜啊

ykcbf1100

于箱长 发表于 2023-7-4 10:10
老兄这字典嵌套玩儿得是真溜啊

我主要玩字典其它不太会啊。

于箱长

ykcbf1100 发表于 2023-7-4 10:28
我主要玩字典其它不太会啊。

暂时欠老兄三朵小红花，等小花恢复的时候补上

ykcbf1100

于箱长 发表于 2023-7-4 10:33
暂时欠老兄三朵小红花，等小花恢复的时候补上

小花无所谓了。开心就好。

准提部林

也是字典...只轉彎不嵌套//一次迴圈完成
Sub TEST_A1()
Dim Arr, Brr, xD, i&, T$, N&, R&, C%, Cx%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([c1], [a65536].End(3))
ReDim Brr(1 To UBound(Arr) / 2, 1 To 200)
For i = 2 To UBound(Arr)
    T = Arr(i, 3): R = xD(T): C = xD(T & "/c")
    If R = 0 Then N = N + 2: R = N: xD(T) = R: Brr(R - 1, 1) = T
    C = C + 1: xD(T & "/c") = C
    If C > Cx Then Cx = C
    Brr(R - 1, C + 1) = Arr(i, 1)
    Brr(R, C + 1) = "'" & Arr(i, 2)
Next i
[e2].Resize(N, Cx + 1) = Brr
End Sub