怎么实现sumif一样的功能

发粪涂墙911

左边区域有相同姓名同学的成绩数据，怎么把名字相同的成绩加在一起，并只显示一行。想看看各位老师用vba怎么实现的。感谢。实际列要比附件的多。



.........................................
自己写了一个（第二个附件），感觉列多的话，代码重复的好多...

苏小亓

直接用透视表

无关岁月

365的话就简单了

1. =GROUPBY(A1:A7,B1:E7,SUM,3)

复制代码

发粪涂墙911

苏小亓 发表于 2024-8-23 16:32
直接用透视表

嗯嗯。就是想看看各位老师用VBA怎么实现的

cidanji

kkf5560

供参考......

ykcbf1100

参与一下，字典+数组

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.23
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 5)
   
6.         ReDim brr(1 To r, 1 To 5)
   
7.         For i = 2 To UBound(arr)
   
8.             s = arr(i, 1)
   
9.             If Not d.exists(s) Then
   
10.                 m = m + 1
    
11.                 d(s) = m
    
12.                 For j = 1 To UBound(arr, 2)
    
13.                     brr(m, j) = arr(i, j)
    
14.                 Next
    
15.             Else
    
16.                 r = d(s)
    
17.                 For j = 2 To UBound(arr, 2)
    
18.                     brr(r, j) = brr(r, j) + arr(i, j)
    
19.                 Next
    
20.             End If
    
21.         Next
    
22.         .[l2:p1000] = ""
    
23.         .[l2].Resize(m, 5) = brr
    
24.     End With
    
25.     Set d = Nothing
    
26.     MsgBox "OK！"
    
27. End Sub
    
28. 
    

复制代码

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
   If Not d.exists(arr(i, 1)) Then
      m = m + 1
      For j = 1 To UBound(arr, 2)
         brr(m, j) = arr(i, j)
      Next
      d(arr(i, 1)) = m
   Else
      r = d(arr(i, 1))
      For j = 2 To UBound(arr, 2)
         brr(r, j) = brr(r, j) + arr(i, j)
      Next
   End If
Next
[l1].CurrentRegion.Offset(1).ClearContents
[l2].Resize(m, UBound(brr, 2)) = brr
End Sub

发粪涂墙911

ykcbf1100 发表于 2024-8-23 18:29
参与一下。。。

谢谢老师。学习一下