|
本帖最后由 zhaogang1960 于 2012-9-15 23:58 编辑
短信收到,请测试- Private Sub Worksheet_Change(ByVal Target As Range)
- If Target.Address(0, 0) <> "C2" Then Exit Sub
- If Target = "" Then Exit Sub
- Dim arr, brr(), d As Object, c As Range, i&, j&
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a3:a" & Range("a65536").End(xlUp).Row)
- For i = 1 To UBound(arr)
- d(arr(i, 1)) = i
- Next
- ReDim brr(1 To i - 1, 1 To 1)
- With Sheets("表2")
- arr = .Range("A1").CurrentRegion
- Set c = .Range("a:a").Find(Target, , , 1, , , True)
- If Not c Is Nothing Then
- i = c.Row
- For j = 2 To UBound(arr, 2)
- If d.Exists(arr(1, j)) Then brr(d(arr(1, j)), 1) = arr(i, j)
- Next
- End If
- End With
- [c3].Resize(d.Count) = brr
- End Sub
复制代码 |
|