怎么根据条件求和

tangyj

ykcbf1100 发表于 2023-12-18 20:52
更新一下，加上排序功能

大佬您好，很感谢你的帮助，我想在你的代码上精简一下，想按乡镇名，学校、小组筛选并汇总管护面积（如下图），也就是想把班级这列不出现在汇总生成的表上，改后代码运行就通不过

ykcbf1100

tangyj 发表于 2024-5-23 16:51
大佬您好，很感谢你的帮助，我想在你的代码上精简一下，想按乡镇名，学校、小组筛选并汇总管护面积（如下 ...

这样改一下。。。

ykcbf1100

代码更新。。。

1. Sub ykcbf()  '//2024.5.23
   
2.     Dim arr, brr, d, s
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("b8")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         Set Rng = .Range("a4:i" & r)
   
7.         With ActiveSheet.Sort
   
8.             .SortFields.Clear
   
9.             For x = 1 To 4
   
10.                 .SortFields.Add2 Key:=Rng.Columns(x + 1), SortOn:=0, Order:=1
    
11.             Next
    
12.             .SetRange Rng
    
13.             .Header = 2
    
14.             .Apply
    
15.         End With
    
16.         arr = Rng.Value
    
17.         For i = 1 To UBound(arr)
    
18.             s = arr(i, 2) & "|" & arr(i, 3) & "|" & "|" & arr(i, 5)
    
19.             If Not d.exists(s) Then
    
20.                 d(s) = Array(arr(i, 2), arr(i, 3), arr(i, 5), arr(i, 6), arr(i, 7), arr(i, 8))
    
21.             Else
    
22.                 t = d(s)
    
23.                 t(3) = t(3) & "、" & arr(i, 6)
    
24.                 t(4) = t(4) & "、" & arr(i, 7)
    
25.                 t(5) = t(5) + arr(i, 8)
    
26.                 d(s) = t
    
27.             End If
    
28.         Next
    
29.       
    
30.         .[l17:q1000] = ""
    
31.         With .[l17].Resize(d.Count, 6)
    
32.             .Value = Application.Rept(d.items, 1)
    
33.             .Borders.LineStyle = 1
    
34.             .HorizontalAlignment = xlCenter
    
35.             .VerticalAlignment = xlCenter
    
36.         End With
    
37.     End With
    
38.     Set d = Nothing
    
39.     MsgBox "OK！"
    
40. End Sub
    
41. 
    

复制代码

jjmysjg

shiruiqiang 发表于 2023-12-18 20:52
你想分页汇总还是把所有的表格汇总？
代码分页汇总（原代码有点错误，已修正）

所有表执行，收藏