|
3#
楼主 |
发表于 2008-3-30 13:35:59
|
只看该作者
回复 2# 的帖子
Private Sub CommandButton1_Click()
Dim d As Object, x As Object, w$, rng, i&, arr
Set d = CreateObject("Scripting.Dictionary")
Set x = CreateObject("Scripting.Dictionary")
w = [f1]
rng = Range([a2], [a2].End(xlDown))
[b2:e1000] = ""
ReDim arr(1 To UBound(rng), 1 To 4)
For i = 1 To UBound(rng)
d(rng(i, 1)) = i
Next i
With Sheet1
rng = .Range(.[a2], .[h65536].End(xlUp))
x.Add .[g5].Value, 1: x.Add .[g3].Value, 2: x.Add .[g2].Value, 3: x.Add .[g116].Value, 4
End With
For i = 1 To UBound(rng)
If d.exists(rng(i, 4)) Then
If rng(i, 8) = w And rng(i, 2) = 2 Then
arr(d(rng(i, 4)), x(rng(i, 7))) = arr(d(rng(i, 4)), x(rng(i, 7))) + rng(i, 5)
End If
End If
Next i
[b2].Resize(d.Count, 4) = arr
End Sub
有高手用字典的方式实验,但是不是很明白
With Sheet1
rng = .Range(.[a2], .[h65536].End(xlUp))
x.Add .[g5].Value, 1: x.Add .[g3].Value, 2: x.Add .[g2].Value, 3: x.Add .[g116].Value, 4
End With
由于该位置的数值不是固定的,如何强制赋值? |
|