|
本帖最后由 zhaogang1960 于 2013-1-31 16:53 编辑
ddhhyy16 发表于 2013-1-31 09:38
帮我看看,用你滴方法~谢谢
你这个题目好难啊,费了一个多小时:- Sub Macro1()
- Dim d As Object, ds As Object, sh As Worksheet, a, arr, brr, i&, j&, l&, s$, t
- Set d = CreateObject("scripting.dictionary")
- arr = Sheets("原始数据").Range("A1").CurrentRegion
- For i = 2 To UBound(arr)
- If Len(arr(i, 2)) Then
- If Not d.Exists(arr(i, 2)) Then Set d(arr(i, 2)) = CreateObject("scripting.dictionary")
- d(arr(i, 2))(arr(i, 4)) = d(arr(i, 2))(arr(i, 4)) & "," & i
- End If
- Next
- k = d.Keys
- On Error Resume Next
- For l = 0 To d.Count - 1
- Set sh = Sheets(k(l))
- If Not sh Is Nothing Then
- Set ds = d(k(l))
- With sh.Range("A3").CurrentRegion
- .Offset(1, 3).ClearContents
- brr = .Value
- For i = 2 To UBound(brr)
- If Len(brr(i, 1)) Then s = brr(i, 1) Else s = brr(i, 3)
- t = ds(s)
- If t <> "" Then
- a = Split(t, ",")
- For j = 1 To UBound(a)
- brr(i, arr(a(j), 1) + 3) = arr(a(j), 7)
- Next
- End If
- Next
- .Value = brr
- End With
- End If
- Next
- End Sub
复制代码 |
|