[已解决]怎样用VBA提取并简单汇总

KDZ

     请教：大侠，怎样又VBA将小表的A列相同的名字提取放在T列，并对A列相同一人的O、P、Q列数据进行汇总，最后一行进行合计啊，因数据多只能用VBA,谢谢！！

最佳答案

月排行榜 / 总排行榜

xdragon

2015-11-2 20:27

1. Sub ttl()
   
2.     Dim d As Object, re, i As Long, arr, cnt As Long, n As Long, sumarr(3), j As Long
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("A4:Q" & Cells(Rows.Count, 1).End(xlUp).Row).Value
   
5.     ReDim re(1 To UBound(arr) + 1, 1 To 4)
   
6.     For i = 1 To UBound(arr)
   
7.         If Not d.exists(arr(i, 1)) Then
   
8.             cnt = cnt + 1: d(arr(i, 1)) = cnt: re(cnt, 1) = arr(i, 1)
   
9.         End If
   
10.             n = d(arr(i, 1))
    
11.             For j = 1 To 3
    
12.                 re(n, j + 1) = re(n, j + 1) + arr(i, j + 14)
    
13.                 sumarr(j) = sumarr(j) + arr(i, j + 14)
    
14.             Next
    
15.     Next
    
16.     sumarr(0) = "合计"
    
17.     With Range("T4")
    
18.         .Resize(cnt, 4) = re
    
19.         .Offset(cnt).Resize(, 4) = sumarr
    
20.     End With
    
21. End Sub

复制代码

跳转到最佳答案楼层

xdragon

1. Sub ttl()
   
2.     Dim d As Object, re, i As Long, arr, cnt As Long, n As Long, sumarr(3), j As Long
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("A4:Q" & Cells(Rows.Count, 1).End(xlUp).Row).Value
   
5.     ReDim re(1 To UBound(arr) + 1, 1 To 4)
   
6.     For i = 1 To UBound(arr)
   
7.         If Not d.exists(arr(i, 1)) Then
   
8.             cnt = cnt + 1: d(arr(i, 1)) = cnt: re(cnt, 1) = arr(i, 1)
   
9.         End If
   
10.             n = d(arr(i, 1))
    
11.             For j = 1 To 3
    
12.                 re(n, j + 1) = re(n, j + 1) + arr(i, j + 14)
    
13.                 sumarr(j) = sumarr(j) + arr(i, j + 14)
    
14.             Next
    
15.     Next
    
16.     sumarr(0) = "合计"
    
17.     With Range("T4")
    
18.         .Resize(cnt, 4) = re
    
19.         .Offset(cnt).Resize(, 4) = sumarr
    
20.     End With
    
21. End Sub

复制代码

KDZ

xdragon 发表于 2015-11-2 20:27

           大师：测试后，还有点小问题，请您解决下，见新上传的数据，谢谢！

xdragon

  上面写错了。。。

KDZ

xdragon 发表于 2015-11-3 00:48
上面写错了。。。

      
                大师：不匹配，麻烦再解决下，

KDZ

KDZ 发表于 2015-11-3 11:11
大师：不匹配，麻烦再解决下，

在您的代码前加一个On Error Resume Next，问题解决了，谢谢老师！

xdragon

KDZ 发表于 2015-11-3 15:27
在您的代码前加一个On Error Resume Next，问题解决了，谢谢老师！

我看了下，原因在于你的Q61单元格是中文的，并不是数字，所以不能相加。