- Sub Macro1()
- Dim arr, brr, crr, d, i&, j%, k%, s&
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a1").CurrentRegion
- brr = Range("k1").CurrentRegion
- ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
- For i = 2 To UBound(arr)
- d(arr(i, 1)) = d(arr(i, 1)) & "," & i
- Next
- For i = 2 To UBound(brr)
- If d.exists(brr(i, 1)) Then
- x = Split(d(brr(i, 1)), ",")
- For j = 1 To UBound(x)
- s = s + 1
- For k = 1 To UBound(arr, 2)
- crr(s, k) = arr(x(j), k)
- Next
- Next
- End If
- Next
- Range("a2").Resize(s, UBound(crr, 2)) = crr
- End Sub
复制代码 |