|
如图所示,要求,附件有详细说明,,谢谢大家 了
dsmch老师之前给的代码能解决问题了,可我弄了半天,一循环然后为其找到对应的位置就弄了半天都还是素手无策,搞到半夜了,还是完全是懵的。。。。谢谢老师了,麻烦帮忙再给看看。。。。谢谢了
- Sub Macro1()
- Dim arr, brr, lb, d, d2, i&, j%, k%
- Set d = CreateObject("scripting.dictionary")
- Set d2 = CreateObject("scripting.dictionary")
- arr = [a9:a24]
- brr = Range("a1").CurrentRegion
- w = Array(2, 5)
- ReDim crr(1 To UBound(arr), 1 To UBound(brr) - 1)
- For i = 1 To UBound(arr)
- d(arr(i, 1)) = d(arr(i, 1)) + 1
- Next
- For i = 2 To UBound(brr)
- ReDim lb(1 To 100) '拆分类别放入数组
- n = brr(i, 3) + brr(i, 6)
- s = 0: n2 = 0
- For j = 0 To 1
- x = Split(brr(i, w(j)), "")
- For k = 0 To UBound(x)
- s = s + d(x(k))
- n2 = n2 + 1
- lb(n2) = x(k)
- Next
- Next
- s2 = n * 58 / s
- For j = 1 To n2
- d2(lb(j)) = d2(lb(j)) + s2
- Next
- Erase lb
- Next
- For i = 1 To UBound(arr)
- arr(i, 1) = d2(arr(i, 1))
- Next
- Range("c9").Resize(UBound(arr)) = arr
- End Sub
复制代码
|
|