求助， 老师帮忙合并下，感谢！

糊涂草

第一段
Option Explicit

Private D As Object



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

      If Target.Count = 1 And Not Application.Intersect(Target, Range("c7,l7" & Cells(1, 1))) Is Nothing Then
  
   

        Call TextBox1_Change        '每次显示TextBox及ListBox前都先刷新ListBox1的列表内容

        With TextBox1
            .Activate
            .Visible = True
            .Text = ActiveCell.Value
            .Top = Target.Top
            .Left = Target.Left
            .Width = Target.Width
            .Height = Target.Height
        End With

        With ListBox1
            .Visible = True
            .Top = Target.Offset(1).Top
            .Left = Target.Left
            .Width = Target.Width
            .Height = Target.Height * 8
        End With
    ElseIf TextBox1.Visible = True Then
        TextBox1.Visible = False
        ListBox1.Visible = False
    End If

End Sub

Private Sub TextBox1_Change()
    Dim ke, arr, i%

    Set D = CreateObject("scripting.dictionary")
    arr = Worksheets("辅助项").[A1].CurrentRegion

    For i = 2 To UBound(arr)  '去重
        D(arr(i, 2)) = arr(i, 3)
    Next

    ListBox1.Clear

    For Each ke In D.keys
        '支持汉字模糊查找或拼音首字母模糊查找
        If ke Like "*" & TextBox1.Text & "*" Or UCase(Py(ke)) Like UCase("*" & TextBox1.Text & "*") Then
            ListBox1.AddItem ke
        End If
    Next
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then    '13 for Enter
        If ListBox1.ListCount > 0 Then
            ActiveCell = ListBox1.List(0)      '如果ListBox1中有项目，则填写第1条
            ActiveCell.Offset(1).Select
        End If
    End If

    If KeyCode = 27 Then    '27 for Esc
        TextBox1 = ""
    End If
End Sub


第二段
Private Sub Worksheet_SelectionChange1(ByVal Target As Range)
    If Target.CountLarge > 2 Then Exit Sub
    frmRiQi.Hide
    If Target.Row > 2 And Target.Row <= 11 And Target.Column = 2 Then
        frmRiQi.ShowDate Target
    End If
End Sub

ykcbf1100

求助得有附件，特别是你这样代码行比较多的时候。

糊涂草

ykcbf1100 发表于 2024-3-8 20:08
求助得有附件，特别是你这样代码行比较多的时候。

不好意思漏上传了，感谢老师！