求修改代码

18839208898

模糊查找出来的内容用鼠标点击选择可以正常写入科目代码和科目列内，在科目代码列内直接输入代码模糊查找出来的科目右键移动选择后，按回车无效，不能自动写入科目列，麻烦热心的高手们帮忙看看吧，
Dim ARR
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    R = Selection.Row
        Cells(R, "B") = ListBox1.List(ListBox1.ListIndex, 0)
        Cells(R, "I") = ListBox1.List(ListBox1.ListIndex, 1)
    Me.ListBox1.Clear
    Me.TextBox1 = ""
    Me.ListBox1.Visible = False
    Me.TextBox1.Visible = False
    ActiveCell.Offset(1, 0).Select
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim i As Integer
    Dim Language As Boolean, arr1 As Variant, arr2 As Variant, arr3 As Variant, arr4 As Variant
    Dim myStr As String, str_B As String
    With Me.ListBox1
        .Clear
        ARR = Sheets("科目").Range("A2:B" & Sheets("科目").Range("A65536").End(3).Row)
        For i = 1 To UBound(ARR)
            If InStr(ARR(i, 1), TextBox1.Text) Then
                R = ListBox1.ListCount
                .AddItem
                .List(R, 0) = ARR(i, 1)
                .List(R, 1) = ARR(i, 2)
            End If
        Next
    End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Integer, ARR
    If Target.Count = 1 Then
        If Target.Column = 2 And Target.Row > 1 Then
            ARR = Sheets("科目").Range("A2:B" & Sheets("科目").Range("A65536").End(3).Row)
            With Me.TextBox1
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left
                .Width = Target.Width
                .Height = Target.Height
                .Activate
            End With
            With Me.ListBox1
                .Visible = True
                .Top = Target.Top
                .Left = Target.Left + Target.Width
                .Width = Target.Width * 4
                .Height = Target.Height * 5
                .ColumnCount = 2
                .ColumnWidths = "60,120"
                .Column() = Application.Transpose(Array("科目代码", "科目名称"))
                For i = 1 To UBound(ARR)
                    .AddItem
                    .List(i, 0) = ARR(i, 1)
                    .List(i, 1) = ARR(i, 2)
                Next
            End With
        Else
            Me.ListBox1.Clear
            Me.TextBox1 = ""
            Me.ListBox1.Visible = False
            Me.TextBox1.Visible = False
        End If
    End If
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With TextBox1
        Select Case KeyCode
        Case 27    'Esc
            TextBox1.Visible = False
            ListBox1.Visible = False
            Selection.Select
        Case 38    '向上
            ActiveCell.Offset(-1, 0).Select
        Case 40    '向下
            ActiveCell.Offset(1, 0).Select
        End Select
    End With
    With Me.ListBox1
        If KeyCode = 39 And .ListCount > 0 Then         '键盘 右 键
            If .ListCount > 1 Then .ListIndex = 1 Else .ListIndex = -1
            .Activate
        End If
    End With
End Sub
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
AAA = KeyCode

    If KeyCode = 13 And Me.ListBox1.ListIndex > 0 Then     '键盘 Enter 键
        R = Selection.Row
        Cells(R, "B") = ListBox1.List(ListBox1.ListIndex, 0)
        Cells(R, "I") = ListBox1.List(ListBox1.ListIndex, 1)
    Me.ListBox1.Clear
    Me.TextBox1 = ""
    Me.ListBox1.Visible = False
    Me.TextBox1.Visible = False
    ActiveCell.Select
    End If


End Sub