|
昨天做了一大半,今天完成了,干脆也上传吧。- Sub tt()
- Set d = CreateObject("scripting.dictionary")
- Set d1 = CreateObject("scripting.dictionary")
- arr = [a1].CurrentRegion
- For i = 2 To UBound(arr)
- clt = arr(i, 1) 'client
- cltype = arr(i, 1) & "," & arr(i, 2) 'client+type
- d(clt) = d(clt) + arr(i, 3) '字典d保存client的求和
- d1(cltype) = d1(cltype) + arr(i, 3) '字典d1保存client+type的求和
- Next
- d1k = d1.keys: d1t = d1.items
- ReDim brr(0 To UBound(d1t), 1 To 3) '数组brr:client type 占比
- For i = 0 To UBound(d1t)
- crr = Split(d1k(i), ",")
- clt = crr(0): xtype = crr(1)
- brr(i, 1) = clt
- brr(i, 2) = xtype
- If d(clt) > 0 Then brr(i, 3) = d1t(i) / d(clt)
- Next
- d.RemoveAll: d1.RemoveAll
-
- For i = 0 To UBound(brr) '在数组Brr中找到各client的最大值,存入字典d
- clt = brr(i, 1)
- d(clt) = IIf(d(clt) < brr(i, 3), brr(i, 3), d(clt))
- Next
- For i = 0 To UBound(brr) '如果brr中各行比例=最大值,显示为百分比置前,否则置后,存入字典d1
- clt = brr(i, 1)
- If d(clt) = brr(i, 3) Then
- d1(clt) = brr(i, 2) & " " & Format(brr(i, 3), "0%") & Chr(10) & d1(clt)
- Else
- d1(clt) = d1(clt) & "/" & brr(i, 2)
- End If
- Next
-
- [k1].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
- [L1].Resize(d1.Count, 1) = Application.Transpose(d1.items)
- End Sub
复制代码 |
|