|
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Sheets(3).Cells(1, 1).Address Then
Application.ScreenUpdating = False
Dim r1, r2
k = 4
Range("A4:A73").ClearContents
If Sheets(1).Cells(1, 1) = Sheets(3).Cells(1, 1) Then
r1 = 1
Else
On Error Resume Next
r1 = Sheets(1).Range("a1:a65536").Find(Sheets(3).Cells(1, 1), , , , , xlNext).Row
End If
On Error Resume Next
r2 = Sheets(1).Range("a1:a65536").Find(Sheets(3).Cells(1, 1), , , , , xlPrevious).Row
For i = 0 To r2 - r1
If Sheets(1).Cells(r1 + i, 1) = Cells(1, 1) Then
Cells(k, 2) = Sheets(1).Cells(r1 + i, 2)
k = k + 1
End If
Next
Application.ScreenUpdating = True
End If
End Sub
|
|