我简单做了一个报名表格，设计如下图。其中，“报名日期”根据电脑的系统时间自动填充。除了必要信息的填写栏，还要求这张报名表具备以下3项功能：

1. 提交

完成表格后，点击“提交”按钮，显示“提交成功”的提示；关键信息未填写时，提示“无法提交”。提交成功后，所填写的数据自动保存到“数据”工作表。效果如下图：

2. 新建

完成上一张表格后，点击“新建”按钮，所有信息自动清空。效果如下图：

3. 查询

对已有表格，只要知道其中任意1项已知信息，例如编号，点击“查询”按钮，其余信息即可呈现。效果如下图：

以下是实现上述按钮功能的宏：

（若移动设备无法显示全部代码，可左右滑动）

“提交”按钮

 1Sub 提交()2Application.ScreenUpdating = False3Dim n%, m%, x%, y%, k%4On Error GoTo 1005    If Sheets("数据").[A:A].Find([J3]) = [J3] Then6        MsgBox "已保存！"7    Else8100:9        If [C4] = "" Then MsgBox "没有填写姓名，不能保存！": End
10        m = Sheets("数据").[A65536].End(xlUp).Row + 1
11        With Sheets("数据")
12            .Cells(m, "A").Value = [J3] '编号
13            .Cells(m, "B").Value = [J4] '报名日期
14            .Cells(m, "C").Value = [C4] '姓名
15            .Cells(m, "D").Value = [C5] '学号
16            .Cells(m, "E").Value = [C6] '所在院系
17            .Cells(m, "F").Value = [B7] '手机号
18            .Cells(m, "G").Value = [F7] '电子邮箱
19            .Cells(m, "H").Value = [B8] '参赛作品
20        End With
21        MsgBox "提交成功！"
22    End If
23ActiveWorkbook.Save
24Application.ScreenUpdating = True
25End Sub

“新建”按钮

 1Sub 新建()2Dim es As Range, k%, m$, i%3Dim rng1 As Range, rng2 As Range4On Error Resume Next5Application.ScreenUpdating = False6[J4] = Format(Now())7Set es = Sheets("数据").Columns(1).Find("*", , xlFormulas, , , xlPrevious)8k = Format(Mid(es.Value, 6, 1), "00")9m = Format(Mid(es.Value, 9, 3), "000")
10i = Format(Now, "mm")
11    If Sheets("数据").Range("A2") = "" Then [J3] = Format(Now, "yyyymm") & "001": Exit Sub
12        If i > k Then
13            [J3] = Format(Now, "yyyymm") & "001": End
14        ElseIf i = k Then
15            [J3] = Format(Now, "yyyymm") & Format(m + 1, "000")
16        End If
17Sheets("表格").Range("C4:H4,C5:H5,C6:H6,J5,J6,B7.D7,F7,H7,J7,B8,D8,F8,H8,J8") = ""
18Application.ScreenUpdating = True
19End Sub

“查询”按钮

 1Sub 查询()2Dim rg As Range, i%, j%3Application.ScreenUpdating = False4If IsNumeric([J3]) = False Then MsgBox "编号错误": Exit Sub5Set rg = Sheets("数据").Columns(1).Find([J3], , , 1)6If rg Is Nothing Then MsgBox "编号格式不正确或查询不到数据！": Exit Sub7With Sheets("数据")8    i = .Columns(1).Find([J3], searchdirection:=xlNext).Row9    arr = .Range("a" & i & ":w" & i)
10        [J4] = arr(1, 2) '报名日期
11        [C4] = arr(1, 3) '姓名
12        [C5] = arr(1, 4) '学号
13        [C6] = arr(1, 5) '所在院系
14        [B7] = arr(1, 6) '手机号
15        [F7] = arr(1, 7) '电子邮箱
16        [B8] = arr(1, 8) '参赛作品
17End With
18Application.ScreenUpdating = True
19End Sub