|
- Sub Macro1()
- Dim arr, brr, d, d2, i&
- Set d = CreateObject("scripting.dictionary") '创建字典对象d
- Set d2 = CreateObject("scripting.dictionary") '创建字典对象d2
- arr = Range("a1").CurrentRegion '单元格赋值数组
- ReDim brr(1 To UBound(arr) - 1, 1 To 1)
- For i = 2 To UBound(arr) '循环数组
- d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 3) '同类项第三列累加
- If arr(i, 3) > 0 Then d2(arr(i, 1)) = d2(arr(i, 1)) + 1 '统计同类项大于0的个数
- Next
- For i = 2 To UBound(arr) '数组赋值字典
- If Not d2.exists(arr(i, 1)) Then
- brr(i - 1, 1) = 0
- Else
- brr(i - 1, 1) = d(arr(i, 1)) / d2(arr(i, 1)) '累加/个数
- End If
- Next
- Range("d2").Resize(UBound(brr)) = brr '数组赋值单元格
- End Sub
复制代码 |
|