一维表转二维表

wang-way

lizhipei78 发表于 2024-10-22 17:06
借题练习一下JSA

ykcbf1100

练习一下。。。

ykcbf1100

1. Sub ykcbf()    '//2025.4.10
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     arr = Sheets("费用表").UsedRange
   
6.     ReDim brr(1 To 10000, 1 To 100)
   
7.     On Error Resume Next
   
8.     With Sheets("2-支出项")
   
9.         r = .UsedRange.Find("*", , -4163, , 1, 2).Row
   
10.         For j = 3 To 11
    
11.             d1(.Cells(1, j).Value) = j
    
12.         Next
    
13.         For i = 2 To UBound(arr)
    
14.             If arr(i, 1) = Empty Then Exit For
    
15.             If arr(i, 3) <> "主卡" Then
    
16.                 s = arr(i, 3)
    
17.                 If Not d.exists(s) Then
    
18.                     m = m + 1
    
19.                     d(s) = m
    
20.                     brr(m, 2) = s
    
21.                 End If
    
22.                 r = d(arr(i, 3))
    
23.                 If arr(i, 4) Like "*险*" Then arr(i, 4) = "保险"
    
24.                 s = arr(i, 4)
    
25.                 If d1.exists(s) Then
    
26.                     brr(r, d1(s)) = brr(r, d1(s)) + arr(i, 5)
    
27.                 End If
    
28.             End If
    
29.         Next
    
30.         .UsedRange.Offset(1) = Empty
    
31.         .[a2].Resize(m, 11) = brr
    
32.     End With
    
33.     Set d = Nothing
    
34.     Set d1 = Nothing
    
35.     Application.ScreenUpdating = True
    
36.     MsgBox "OK！"
    
37. End Sub
    
38. 
    

复制代码

沈默00

=PIVOTBY(C2:C13,D2:D13,E2:E13,SUM,,0,,0,,C2:C13<>"主卡")