ARTICLE · 1337598
Excel-vba高级录入窗体|下拉选择+自动时间+重复校验,防重复,录完自动追加台账
Excel-vba高级录入窗体|下拉选择+自动时间+重复校验,防重复,录完自动追加台账 很多人做窗体录入，只做了简单填写，实际用的时候踩一堆坑：部门、状态每次手动敲字容易不一致；日期还要手动填；同个编号重复录入，台账重复了后面对账头大。 应大家要求这个升级版全部补上：下拉选项、自动生成录入时间、编号重复拦截，提交成功清空窗体，代码实测可用，逻辑严谨。 重要提示：UserForm用户窗体，微软Excel稳定可用；部分WPS个人精简版不支持窗体，优先Excel；文件必须另存为 xlsm 启用宏格式。 
准备工作 工作表名称： 台账 表头（A~E列） A：编号｜B：姓名｜C：部门｜D：录入时间｜E：备注 窗体控件清单（UserForm1） 1. Label5个：编号、姓名、部门、录入时间、备注 2. txtNo（文本框，编号，用来查重） 3. txtName（文本框，姓名） 4. cboDept（组合框ComboBox，部门下拉，不能手动乱输，可选锁定） 5. txtTime（文本框，录入时间，设为只读，不让改） 6. txtRemark（文本框，备注） 7. cmdSubmit 按钮：提交保存 8. cmdClose 按钮：关闭窗体 UserForm1 完整窗体代码（直接粘贴） vba Option Explicit Private Sub UserForm_Initialize() '窗体打开的时候，给下拉框加载部门选项，自行增删 With Me.cboDept .AddItem "生产部" .AddItem "质检部" .AddItem "仓储部" .AddItem "行政部" .AddItem "销售部" 'Style=2：只能下拉选择，禁止手动输入 .Style = 2 End With '时间框只读 Me.txtTime.Locked = True Me.txtTime.BackColor = RGB(240, 240, 240) End Sub Private Sub txtNo_AfterUpdate() '输入编号离开后，自动查重，提前提醒 Dim ws As Worksheet, rng As Range Set ws = ThisWorkbook.Worksheets("台账") Set rng = ws.Range("A:A").Find(What:=Trim(Me.txtNo.Value), LookIn:=xlValues, LookAt:=xlWhole) If Not rng Is Nothing Then MsgBox "警告：该编号已经存在，禁止重复录入！", vbCritical Me.txtNo.Value = "" Me.txtNo.SetFocus End If End Sub Private Sub cmdSubmit_Click() Dim ws As Worksheet Dim lastRow As Long Dim rngFind As Range Dim bh As String bh = Trim(Me.txtNo.Value) '必填项校验 If bh = "" Then MsgBox "编号不能为空！", vbExclamation Me.txtNo.SetFocus Exit Sub End If If Trim(Me.txtName.Value) = "" Then MsgBox "姓名不能为空！", vbExclamation Me.txtName.SetFocus Exit Sub End If If Me.cboDept.Value = "" Then MsgBox "请选择部门！", vbExclamation Me.cboDept.SetFocus Exit Sub End If Set ws = ThisWorkbook.Worksheets("台账") '二次查重（防止多人同时录入、快速点击提交绕过上面的失去焦点校验） Set rngFind = ws.Range("A:A").Find(What:=bh, LookIn:=xlValues, LookAt:=xlWhole) If Not rngFind Is Nothing Then MsgBox "提交拦截：编号重复，无法保存！", vbCritical Exit Sub End If lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1 '写入数据 ws.Cells(lastRow, "A").Value = bh ws.Cells(lastRow, "B").Value = Trim(Me.txtName.Value) ws.Cells(lastRow, "C").Value = Me.cboDept.Value ws.Cells(lastRow, "D").Value = Now() '自动时间，带日期时分秒 ws.Cells(lastRow, "E").Value = Trim(Me.txtRemark.Value) MsgBox "✅ 录入成功！已追加到台账末尾", vbInformation '提交后清空，准备下一条录入 Me.txtNo.Value = "" Me.txtName.Value = "" Me.cboDept.Value = "" Me.txtRemark.Value = "" Me.txtTime.Value = "" Me.txtNo.SetFocus End Sub Private Sub cmdClose_Click() Unload Me End Sub 模块代码（新建模块，用来调出窗体，给表格按钮绑定这个宏） vba Sub 打开高级录入窗体() UserForm1.Show End Sub 
修改说明（按需改，不破坏原有逻辑） 1. 下拉选项增减：找到 UserForm_Initialize 里面的 .AddItem ，直接加或者删掉部门名称就行 2. 时间只保留日期，不要时分秒：把 Now() 换成 Date() 3. 想要编号自动生成、不用手动输入：删掉txtNo控件，去掉查重代码，写入行改成 ws.Cells(lastRow, "A").Value = "BH-" & Format(lastRow - 1, "0000") 4. 想要提交之后不清空窗体：删掉末尾清空那一段代码 注意事项 1. 工作表名称严格叫【台账】，多空格、改名字都会报错；改名字就要同步改代码里 Worksheets("台账") 2. 控件名称不能错：组合框必须叫 cboDept ，按钮、文本框名称和代码对应，名字写错直接报错 3. 保存格式：另存为【启用宏的工作簿(*.xlsm)】，普通xlsx不存窗体和宏 4. 宏设置：文件打开后，Excel顶部启用宏，否则按钮点了没反应 5. 查重是整单元格完全匹配：编号 "BH001" 和 "BH001 " 带空格不会判定重复，代码里已经加了Trim去除前后空格 搭配之前功能联动 录入窗体 + 工作表保护代码：录入只走弹窗，台账工作表锁定，其他人不能直接在表格修改历史记录，整套多人台账闭环。 ❤️要不要【查询+修改本条记录】？需要的话私信留言，关注收藏不迷路，持续分享办公实用技巧 Excel-多人共用台账乱改表头？这个VBA一键设置区域保护，只让填该填的地方 一键导入外部Excel！VBA文件选择器，自动提取数据到当前表 上班做数据分析加班半天？这8组万能公式，搞定90%报表需求 Excel与VBA：在公众号中解锁数据处理的无限可能
