[已解决]满足条件，多条件提取不重复值求和

qh8600

不重复值求和.rar (1.75 KB, 下载次数: 75)

2014-3-22 14:38 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-22 14:55

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, zf$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1").CurrentRegion
   
5. [h:j].ClearContents
   
6. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
7. For i = 2 To UBound(arr)
   
8.     If arr(i, 1) > 103 Then
   
9.         zf = arr(i, 1) & "," & arr(i, 2)
   
10.         If Not d.exists(zf) Then
    
11.             s = s + 1
    
12.             d(zf) = s
    
13.             brr(s, 1) = arr(i, 1)
    
14.             brr(s, 2) = arr(i, 2)
    
15.             brr(s, 3) = arr(i, 3)
    
16.         Else
    
17.             brr(d(zf), 3) = brr(d(zf), 3) + arr(i, 3)
    
18.         End If
    
19.     End If
    
20. Next
    
21. [a1:c1].Copy [h1]
    
22. Range("h2").Resize(s, 3) = brr
    
23. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, zf$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1").CurrentRegion
   
5. [h:j].ClearContents
   
6. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
7. For i = 2 To UBound(arr)
   
8.     If arr(i, 1) > 103 Then
   
9.         zf = arr(i, 1) & "," & arr(i, 2)
   
10.         If Not d.exists(zf) Then
    
11.             s = s + 1
    
12.             d(zf) = s
    
13.             brr(s, 1) = arr(i, 1)
    
14.             brr(s, 2) = arr(i, 2)
    
15.             brr(s, 3) = arr(i, 3)
    
16.         Else
    
17.             brr(d(zf), 3) = brr(d(zf), 3) + arr(i, 3)
    
18.         End If
    
19.     End If
    
20. Next
    
21. [a1:c1].Copy [h1]
    
22. Range("h2").Resize(s, 3) = brr
    
23. End Sub
    

复制代码

dsmch

………………