|
- Sub test0() '删除 表一 表二 表三 字样,以免干扰数据装入数组
- Dim ar, br, cr, dict As Object
- Dim i As Long, s As String, Flag As Boolean
- Set dict = CreateObject("Scripting.DictionAry")
- ar = Range("B1").CurrentRegion.Value
- For i = 2 To UBound(ar)
- dict.Add ar(i, 2), Array(i, ar(i, 1))
- ar(i, 3) = 0
- Next
- br = Range("M1").CurrentRegion.Value
- For i = 1 To UBound(br)
- dict(br(i, 1)) = dict(br(i, 1)) + Val(br(i, 2))
- Next
- br = Range("H1").CurrentRegion.Value
- For i = 1 To UBound(br)
- If Len(br(i, 1)) Then
- s = br(i, 1)
- Flag = dict.Exists(s)
- If Flag Then cr = dict(s)
- End If
- If Flag Then ar(cr(0), 3) = ar(cr(0), 3) + dict(cr(1) & br(i, 2))
- Next
- Range("B1").CurrentRegion.Value = ar
- Set dict = Nothing
- Beep
- End Sub
复制代码 |
|