符合条件的显示出来

路的前方是梦想

麻烦各位老师指导下，如附件所示，实现符合条件的显示出来，谢谢！

迪尼索斯

0123456789

gwjkkkkk

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ar, br$(), i&, j&
   
    If Target.Address = "$J$4" Then
         ar = [A5].CurrentRegion
         ReDim br(1 To UBound(ar), 1 To 2)
         strtxt = Target.Value
         For i = 3 To UBound(ar)
             If ar(i, 1) = strtxt Then
                 r = r + 1
                 For j = 2 To 3
                     br(r, j - 1) = ar(i, j)
                 Next j
             End If
         Next i
         If r = 0 Then MsgBox "未发现数据": Exit Sub
         Application.EnableEvents = False
         [I4].CurrentRegion.Offset(3).Clear
         [I7].Resize(r, 2) = br
         Application.EnableEvents = True
    End If
End Sub

gwjkkkkk

请参考附件。。。