在Excel中创建测验时锁定答案

时间:2018-08-06 21:13:36

标签: excel excel-vba excel-formula

我正在为我工​​作的公司创建测验。

前提很简单;一个工作表上的问题,另一个工作表上的答案。他们在公式中的另一个字段中输入答案

>>> activities_lst = [{'user': 549, 'day': 24, 'month': 7, 'year': 2018}, {'user': 350, 'day': 24, 'month': 7, 'year': 2018}, {'user': 746, 'day': 31, 'month': 7, 'year': 2018}, {'user': 1, 'day': 31, 'month': 7, 'year': 2018}, {'user': 1, 'day': 24, 'month': 7, 'year': 2018}, {'user': 1, 'day': 24, 'month': 7, 'year': 2018}, {'user': 526, 'day': 31, 'month': 7, 'year': 2018}, {'user': 526, 'day': 24, 'month': 7, 'year': 2018}, {'user': 109, 'day': 24, 'month': 7, 'year': 2018}, {'user': 419, 'day': 24, 'month': 7, 'year': 2018}]
>>>
>>> from itertools import groupby
>>> f = lambda x: x['user']
>>> res = {user:['{year}-{month:02}-{day}'.format(**date) for date in date_lst] for user,date_lst in groupby(sorted(activities_lst, key=f), f)}
>>> res = {user:{date:len(list(v)) for date,v in groupby(date_lst)} for user,date_lst in res.items()}
>>> 
>>> from pprint import pprint
>>> pprint(res)
{1: {'2018-07-24': 2, '2018-07-31': 1},
 109: {'2018-07-24': 1},
 350: {'2018-07-24': 1},
 419: {'2018-07-24': 1},
 526: {'2018-07-24': 1, '2018-07-31': 1},
 549: {'2018-07-24': 1},
 746: {'2018-07-31': 1}}

告诉该人答案是否正确。我正在使用带有下拉列表的数据验证,因此他们只能选择true / false,(a,b,c,d)等。

在用户放置选择的答案之后,是否有方法可以锁定选择的答案,直到按下主重置按钮?

例如,

  • 问题在A1中
  • 可能的答案以B1中的下拉菜单形式出现。
  • 有时候答案是对的,否则是选择题。在“ true false”示例中,如果此人输入“ true”,则c3会说“正确”,或者如果他们输入“ false”,则表示错误。
  • 现在,此人可以根据需要来回切换。我想做的就是做到这一点,这样一旦答案被锁定,他们就无法更改。

2 个答案:

答案 0 :(得分:3)

您可以将工作表保护与范围锁定和更改事件结合使用。

将此代码放在相关的Worksheet模块中。调整Private常数以适合您的需求。

Option Explicit

' Reference the cells that your users may enter data into
Private Const DataCells As String = "J1,J3,J5"
Private Const PW As String = "password"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cl As Range
    Dim DataRange As Range

    Set DataRange = Me.Range(DataCells)
    'Loop thru changed cells
    For Each cl In Target.Cells
        'If changed cell is in the DataCells range and is not blank, lock it
        If Not Application.Intersect(cl, DataRange) Is Nothing Then
            If Not IsEmpty(cl) Then
                Me.Unprotect PW
                Target.Locked = True
                Me.Protect PW
            End If
        End If
    Next
End Sub

'Re-enable data entry to all DataCells
Sub MasterReset()
    'Unlock the sheet, prompt for password
    Me.Unprotect
    'Unlock the cells
    Me.Range(DataCells).Locked = False
    'Optional, clear DataCells
    Me.Range(DataCells).ClearContents
    'Lock the sheet again
    Me.Protect PW
End Sub

答案 1 :(得分:1)

效果很好:

在“此工作簿”模块中,插入代码:

Private Sub Workbook_Open()

    Sheet1.Protect userinterfaceonly:=True 'allows macros to run
    Sheet1.Range("A1:A20").Locked = False 'replace this range with the range the user deals with.

End Sub

在用户将要与之交互的工作表模块中,添加以下代码:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Locked = True Then Exit Sub

    If Target.Locked = False Then
        If Target.Value = "" Then Exit Sub
        If Target.Value <> "" Then Target.Locked = True
    End If

End Sub

那应该为您做好事!