新手寻求帮助

a11121321321

请问下下列附件内容如何可以实现数字输入选题不用鼠标1下1下点 代码如下
Option Explicit
Dim Tiku，Lr1 As Long
Private Sub CommandButton1_Click（）
    On Error GoTo lin1
    Dim i As Long
    Dim j As Long
    Dim Max1 As Long
    Dim Min1 As Long
    Dim Shitihao
    Dim S As String，X As String
    Dim k As Long。Dim k As Long
    Dim l As Long
    Dim jishu As Long
    Dim time1
    S =Format（Now，“yyyy年mm月”）＆“财务人员培训试题”＆vbCrLf＆vbCrLf＆“姓名：__________________部门：________________成绩：____________”＆vbCrLf
    X =Format（Now，“yyyy年mm月”）＆“财务人员培训试题答案”＆vbCrLf
    For i = 0 To Me.ListBox1.ListCount  -  1
        jishu = 0
        Max1 = 999999
        Min1 = 99999
        For j = 2 To Lr1
            If Tiku（j，2）= Me.ListBox1.List（i） Then
                Max1 = j
                If Max1 < Min1 Then
                    Min1 = Max1
                End If
            End If
                万一
            万一
        下一个
        如果CLng（Me.ListBox2.List（i））<=（Max1  -  Min1 + 1）那么
            Shitihao =不重复随机数（Min1，Max1，CLng（Me.ListBox2.List（i）））
        其他
            MsgBox Me.ListBox1.List（i）＆“数量不能大于”＆（Max1  -  Min1 + 1）＆“个”
            结束
        万一
        S = S＆vbCrLf＆Application.WorksheetFunction.Text（i + 1，“[dbnum1]”）＆“，”＆Me.ListBox1.List（i）＆vbCrLf
        X = X＆vbCrLf＆Application.WorksheetFunction.Text（i + 1，“[dbnum1]”）＆“，”＆Me.ListBox1.List（i）＆vbCrLf
        对于k = 1到UBound（Shitihao）
            对于l = 3到13
                如果Tiku（Shitihao（k），l）<>“”那么
                    如果l = 3那么jishu = jishu + 1
                    S = S＆IIf（l = 3，jishu＆“，”，vbCrLf＆Space（3））＆Tiku（Shitihao（k），l）
                万一
            下一个
            S = S＆vbCrLf
            X = X＆jishu＆“，”＆Tiku（Shitihao（k），l）＆vbCrLf
        下一个
    下一个
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    使用CreateObject（“Word.Application”）
    time1 =格式（现在，“yyyymmddhhmmss”）
        使用.Documents.Add
            .Paragraphs（1）.Range.Text = S
            .SaveAs文件名：= ThisWorkbook.Path＆“\”＆time1＆“培训考试题.doc”
            。关
        结束
        使用.Documents.Add
            .Paragraphs（1）.Range.Text = X
            .SaveAs文件名：= ThisWorkbook.Path＆“\”＆time1＆“培训考试题答案.doc”
            。关
        结束
林1：
        如果Err.Number <> 0 Then MsgBox“出错了，请关闭所有打开的文档”
        。放弃
    结束
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    结束
结束小组
Private Sub CommandButton2_Click（）
    结束
结束小组
Private Sub ListBox1_Click（）
    Me.ListBox2.ListIndex = Me.ListBox1.ListIndex
结束小组
Private Sub ListBox2_Click（）
    Me.ListBox1.ListIndex = Me.ListBox2.ListIndex
结束小组
Private Sub ListBox2_DblClick（ByVal Cancel As MSForms.ReturnBoolean）
    如果Me.ListBox2.ListIndex> = 0那么
        Me.ListBox2.List（Me.ListBox2.ListIndex）= CLng（Me.ListBox2.List（Me.ListBox2.ListIndex））+ 1
    万一
结束小组
Private Sub ListBox2_MouseDown（ByVal Button As Integer，ByVal Shift As Integer，ByVal X As Single，ByVal y As Single）
    如果Me.ListBox2.ListIndex> = 0那么
        如果Button = 2并CLng（Me.ListBox2.List（Me.ListBox2.ListIndex））> 1然后
            Me.ListBox2.List（Me.ListBox2.ListIndex）= CLng（Me.ListBox2.List（Me.ListBox2.ListIndex）） -  1
        万一
    万一
结束小组
Private Sub UserForm_Initialize（）
    Dim d1 As Object
    昏暗我很久
    Dim k
    设置d1 = CreateObject（“Scripting.Dictionary”）
    Tiku = ActiveSheet。[a1] .CurrentRegion
    Lr1 = UBound（Tiku）
    对于i = 2到Lr1
        d1（Tiku（i，2））=“”
    下一个
    k = d1.keys
    对于i = 0到d1.Count  -  1
        Me.ListBox1.AddItem k（i）
        Me.ListBox2.AddItem 1
    下一个
    设置d1 =无
结束小组
Private Sub UserForm_QueryClose（取消为整数，CloseMode为整数）
    结束
结束小组
Public Function不重复随机数（小数As Long，大数As Long，个数As Long）
    昏暗我很久
    如果个数>大数 - 小数+ 1则退出函数
    Dim arr（）
    ReDim arr（个数 -  1）
    Dim b（）As Boolean
    ReDim b（大数 - 小数）
    Dim X As Long，y As Long
    随机化
    对于i = 0到个数 -  1
        做
            X = Int（Rnd *（大数 - 小数+ 1））+小数
            y = X  - 小数
        循环虽然b（y）
        b（y）=真
        arr（i）= X
    接下来我
    不重复随机数= Application.Transpose（Application.Transpose（arr））
结束功能