如何用代码实现类似于透视结果

sampsonpon

如图，类似于实现透视结果

shiruiqiang

想看吗？

sampsonpon

shiruiqiang 发表于 2024-4-22 15:13
想看吗？

不好意思！现在去掉了

baofa2

参考.zip (617 KB, 下载次数: 10)

2024-4-22 16:33 上传

点击文件名下载附件

sampsonpon

baofa2 发表于 2024-4-22 16:33

朋友，我选择test11的，
能不能把空白去掉？也就是G列空白不参与计算；另外，G2:G去重后横向写时没有排序
并且，最后一整行的合计数据不要

baofa2

调整简单，自己试吧……

补
全都简单的调整.zip (612.7 KB, 下载次数: 5)

2024-4-23 07:58 上传

点击文件名下载附件

baofa2

1. Sub test11()  'Array + Dictionary
   
2.   Dim result(), data, dict As Object, strKey As String, i As Long, j As Long
   
3.   Dim rowSize As Long, colSize As Long, posRow As Long, posCol As Long
   
4.   
   
5.   Application.ScreenUpdating = False
   
6.   
   
7.   Set dict = CreateObject("Scripting.Dictionary")
   
8.   data = Sheet14.Range("A1").CurrentRegion.Value
   
9.   
   
10.   With CreateObject("Excel.Sheet") '''''''''''''''''''''加，用于排序
    
11.     With .Worksheets(1).Range("A1").Resize(UBound(data), UBound(data, 2))
    
12.       .Value = data
    
13.       .Sort .Item(7), xlAscending, , , , , , xlYes
    
14.       data = .Value
    
15.     End With
    
16.     .Close
    
17.   End With '''''''''''''''''''''''''''''''''''''''''''''''
    
18.   
    
19.   ReDim result(1 To UBound(data), 1 To 800)
    
20.   rowSize = 1
    
21.   colSize = 1
    
22.   result(rowSize, colSize) = data(1, 1)
    
23.   For i = 2 To UBound(data)
    
24.     strKey = Trim(data(i, 1))
    
25.     If Not dict.Exists(strKey) Then
    
26.       rowSize = rowSize + 1
    
27.       result(rowSize, 1) = strKey
    
28.       dict.Add strKey, rowSize
    
29.     End If
    
30.     posRow = dict(strKey)
    
31.     strKey = Trim(data(i, 7))
    
32.     If strKey <> "" Then             '加
    
33.       If Not dict.Exists(strKey) Then
    
34.         colSize = colSize + 1
    
35.         result(1, colSize) = strKey
    
36.         dict.Add strKey, colSize
    
37.       End If
    
38.       posCol = dict(strKey)
    
39.       result(posRow, posCol) = result(posRow, posCol) + Val(data(i, 10))
    
40.     End If                           '加
    
41.   Next
    
42.   'rowSize = rowSize + 1
    
43.   colSize = colSize + 1
    
44.   'result(rowSize, 1) = "总计"
    
45.   result(1, colSize) = "总计"
    
46.   For j = 2 To colSize - 1
    
47.     For i = 2 To rowSize '- 1
    
48.       'result(rowSize, j) = result(rowSize, j) + result(i, j)
    
49.       result(i, colSize) = result(i, colSize) + result(i, j)
    
50.     Next
    
51.     'result(i, colSize) = result(i, colSize) + result(i, j)
    
52.   Next
    
53.   With Sheet15.Range("A1")
    
54.     .CurrentRegion.Clear
    
55.     With .Resize(rowSize, colSize)
    
56.       .HorizontalAlignment = xlCenter
    
57.       .Borders.LineStyle = xlContinuous
    
58.       .Rows(1).Font.Bold = True
    
59.       '.Columns(1).Font.Bold = True
    
60.       .Value = result
    
61.       .Resize(rowSize).Sort .Item(1), xlAscending, , , , , , xlYes
    
62.       .Columns.AutoFit
    
63.     End With
    
64.   End With
    
65.   Set dict = Nothing
    
66.   
    
67.   Application.ScreenUpdating = True
    
68.   Beep
    
69. End Sub

复制代码