VBA计算和引用求和

人生任我行

具体要求在表格内有说明。

grf1973

试试吧，不知行不行。

人生任我行

grf1973 发表于 2013-4-29 15:32
试试吧，不知行不行。

要求重复的相加。

人生任我行

grf1973 发表于 2013-4-29 15:32
试试吧，不知行不行。

指定在B2到B10。如果在不够行的情况下，自动加行。要求重复的相加，显示唯一结果。

grf1973

1. Sub 提取板材()
   
2.     Dim str$
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set sht = Sheet1
   
5.     r = sht.[b65536].End(3).Row
   
6.     arr = sht.Range("b4:k" & r)
   
7.     [b2:g12].ClearContents
   
8.     For i = 1 To UBound(arr)
   
9.         str = arr(i, 4) & "MM" & arr(i, 7)
   
10.         d(str) = d(str) + arr(i, UBound(arr, 2))
    
11.     Next
    
12.     brr = d.keys: crr = d.items
    
13.     If d.Count > 11 Then
    
14.          m = d.Count - 11
    
15.          Rows("5:" & 5 + m - 1).Insert
    
16.     End If
    
17.     For i = 0 To UBound(brr)
    
18.         Cells(i + 2, 2) = brr(i)
    
19.         Cells(i + 2, 3) = crr(i)
    
20.     Next
    
21. End Sub
    

复制代码