|
尊敬的蓝版,您好,麻烦看下http://club.excelhome.net/thread-1348013-1-1.html
我是新人,刚学VBA,自己写了一段,但是运行结果不对,不知道哪里错误,请帮忙修改下
Sub 宏1()
Dim Arr, i&, Brr(1 To 5000, 1 To 5000), j&, n&, aa
Sheet2.Activate
Arr = Sheet2.[a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(Arr)
If InStr(Arr(i, 2), "/") Then
aa = Split(Arr(i, 2), "/")
For j = 0 To UBound(aa)
Brr(i, j + 1) = aa(j)
If Not d.exists(Brr(i, j + 1)) Then
Set d(Brr(i, j + 1)) = Range("c" & i)
Else
Set d(Brr(i, j + 1)) = Union(d(Brr(i, j + 1)), Range("c" & i))
End If
Next
Else
Brr(i, 1) = Arr(i, 2)
If Not d.exists(Brr(i, 1)) Then
Set d(Brr(i, 1)) = Range("c" & i)
Else
Set d(Brr(i, 1)) = Union(d(Brr(i, 1)), Range("c" & i))
End If
End If
Next
[d1].Resize(i, j + 1) = Brr
Sheet1.Activate
r = Range("a65536").End(xlUp).Row
For k = 1 To r
ss = Range("a" & k).Value
If d.exists(ss) Then
Cells(i, 2) = d(ss)
End If
Next
End Sub |
|