[已解决]dsmch老师，不好意思又得麻烦您了，再帮忙看看这个solit的问题

excel小米 · 发表于 2015-2-28 13:36

不好意思 dsmch老师，现在又有这个要求，我是怎么改都改不了。现在的附加的要求是这样的，，有三个参数，A开头的都是乘以58，V开头的都是乘以55，其他字母开头的都是乘以53。。。最大的难点就是，当是A1\A5\V1\V3出现的时候，A1和A5的计算结果都是数量*58/A1+A5(合计出现次数） V1和V3的计算结果都是数量*58/V1+V3(合计出现次数）而不是数量/A1A5V1V3合计数量

谢谢老师了，我实在是没有办法了
，昨晚也是实在没有办法了，束手无策了，在论坛瞎逛，幸运的是荣幸的帮助到了别人（简单的小题了，呜呜）

最佳答案

月排行榜 / 总排行榜

dsmch

2015-2-28 19:36

正确与否，不再修改

Sub Macro1()
Dim arr, brr, lb, d, d2, d3, i&, j%, k%
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
arr = [a7:a25]
brr = Range("a1").CurrentRegion
w = Array(2, 5)
For i = 1 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + 1
Next
d("A") = 58: d("V") = 55
For i = 2 To UBound(brr)
For j = 0 To 1
x = Split(brr(i, w(j)), "")
ReDim lb(1 To 50) '拆分类别放入数组
n = 0: n2 = brr(i, w(j) + 1) '数量
For k = 0 To UBound(x)
n = n + 1
lb(n) = x(k)
z = Left(x(k), 1)
d3(z) = d3(z) + d(x(k))
Next
For jj = 1 To n
z = Left(lb(jj), 1)
If d.exists(z) Then s = d(z) Else s = 53
d2(lb(jj)) = d2(lb(jj)) + n2 * s / d3(z)
Next
Erase lb
d3.RemoveAll
Next
Next
For i = 1 To UBound(arr)
arr(i, 1) = d2(arr(i, 1))
Next
Range("b7").Resize(UBound(arr)) = arr
End Sub

复制代码

跳转到最佳答案楼层

excel小米 · 发表于 2015-2-28 13:37

http://www.excelpx.com/thread-339435-1-1.html
原帖是这个

dsmch · 发表于 2015-2-28 14:00

Sub Macro1()
Dim arr, brr, lb, d, d2, i&, j%, k%
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
arr = [a7:a25]
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
For j = 1 To n2
If lb(j) Like "A*" Then
s2 = 58
ElseIf lb(j) Like "V*" Then
s2 = 55
Else
s2 = 53
End If
d2(lb(j)) = d2(lb(j)) + n * s2 / s
Next
Erase lb
Next
For i = 1 To UBound(arr)
arr(i, 1) = d2(arr(i, 1))
Next
Range("b7").Resize(UBound(arr)) = arr
End Sub

复制代码

excel小米 · 发表于 2015-2-28 17:31

dsmch 发表于 2015-2-28 14:00

老师，太感谢您了，不过由于我表达能力太差了，，，没描述清楚

是这样的，比如B2单元格内容为K1\KP\V1\V3 （K1在A7:A27共出现3次，KP共出现1次，V1和V3也各为一次）其对应的C2单元格的数值为5 的时候，应该是这么算的。。 K1和KP的计算方式是 5(数值）*53（参数）/4（K1的三次+KP的一次）而不把V1和V3的也算上，，，所以，是除以4，而不是除以6

谢谢老师了

dsmch · 发表于 2015-2-28 19:36

正确与否，不再修改

Sub Macro1()
Dim arr, brr, lb, d, d2, d3, i&, j%, k%
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
arr = [a7:a25]
brr = Range("a1").CurrentRegion
w = Array(2, 5)
For i = 1 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + 1
Next
d("A") = 58: d("V") = 55
For i = 2 To UBound(brr)
For j = 0 To 1
x = Split(brr(i, w(j)), "")
ReDim lb(1 To 50) '拆分类别放入数组
n = 0: n2 = brr(i, w(j) + 1) '数量
For k = 0 To UBound(x)
n = n + 1
lb(n) = x(k)
z = Left(x(k), 1)
d3(z) = d3(z) + d(x(k))
Next
For jj = 1 To n
z = Left(lb(jj), 1)
If d.exists(z) Then s = d(z) Else s = 53
d2(lb(jj)) = d2(lb(jj)) + n2 * s / d3(z)
Next
Erase lb
d3.RemoveAll
Next
Next
For i = 1 To UBound(arr)
arr(i, 1) = d2(arr(i, 1))
Next
Range("b7").Resize(UBound(arr)) = arr
End Sub

复制代码

excel小米 · 发表于 2015-2-28 20:13

dsmch 发表于 2015-2-28 19:36
正确与否，不再修改

谢谢老师，您辛苦了。。太感谢您了。回头一定要好好啃您的这个代码。。。谢谢谢谢

		自动登录	找回密码
密码			注册

[已解决]dsmch老师，不好意思又得麻烦您了，再帮忙看看这个solit的问题

点评