本文于2023年8月10日首发于本人同名其他平台，更多文章案例请搜索关注！
内容提要
用户窗体录入数据
大家好，我是冷水泡茶，今天在论坛上看到一个求助贴：
他的明细表是这样的：
当然，今天我不是要说怎么满足他的需求，而是我看到这个明细表，我想到录入这个明细表可能是一件比较费功夫的事，可以利用窗体来录入数据，增加录入的速度、提高数据的准确性。说干就干，经过一番操作，搞定录入数据的问题，其他的功能暂时先放一边。
我们一起来看一看吧：
基本思路
1、设置一个用户窗体，在上面放上“材料录入表”表头字段对应的文本框或复合框控件，供填写或选择录入数据。
2、把“材料录入表”数据读入数组，以备提取“材料名称”、“规格程式”、“单位”等数据，供录入时选择，如果是新的项目，则手工输入，在下次录入时即可选取。
3、点“保存”按钮，把数据写入“材料录入表”。
程序代码
1、在“首页“添加”入库“、“出库”命令按钮：
2、“入库”、“出库”按钮代码：
Private Sub CmdMaterialIn_Click() InOrOut = "入库" UserForm1.Show 0End SubPrivate Sub CmdMaterialOut_Click() InOrOut = "出库" UserForm1.Show 0End Sub
代码解析：
（1）InOrOur，是一个Public变量，记录出入库的类型。
（2）我们点入库，InOrOur=“入库”，点出库，InOrOur=“出库”，然后显示用户窗体UserForm1。
（3）UserForm1.Show 0，这后面的0，表示“无模式”，可以操作表格。如果不加0，或加1，则为“有模式”，不可操作表格。所以，在录入数据的时候，如果要查看、复制其他表格数据的，窗体要显示为“无模式”。
3、UserForm1初始化代码：
Dim ws As WorksheetDim TbTitle()Dim lastRow As Long, iRow As LongDim lastCol As Long, iCol As LongDim arrData()Private Sub UserForm_Initialize() ThisWorkbook.Activate Dim DicName As Object Set DicName = CreateObject("Scripting.Dictionary") Set ws = Sheets("材料录入表") ws.Activate lastRow = ws.UsedRange.Rows.Count lastCol = ws.UsedRange.Columns.Count arrData = ws.Range(Cells(2, 1), Cells(lastRow, lastCol)).Value iRow = UBound(arrData, 1) iCol = UBound(arrData, 2) ReDim TbTitle(1 To iCol) For i = 1 To iCol TbTitle(i) = arrData(1, i) Next For i = 2 To iRow DicName(arrData(i, Pxy(TbTitle, "材料名称"))) = 1 Next If InOrOut = "入库" Then Me.LbTitle = "材料（入库）录入" Me.LbType = "入库" Me.BackColor = 49407 Else Me.LbTitle = "材料（出库）录入" Me.LbType = "出库" Me.BackColor = 5296274 End If Me.TxbDate = Date Me.CmbName.Clear Me.CmbName.List = DicName.keysEnd Sub
代码解析：
（1）把数据读入数组arrData()。
（2）把表头字段存入数组TbTitle()，这是我的“惯用伎俩”，结合Pxy自定义函数取得字段的位置，也就取得了数组的一个下标，或者是单元格的行标或列标，比直接写具体的数字要灵活一点，即便原始数据表头字段位置发生变化，依然能得出正确的结果。当然，性能方面可能牺牲一点点，但就这么点代码量，那是完全感觉不出来的。
（3）把“材料名称”字段的值装入字典去重，赋值给复合框CmbName的List，即材料名称。
（4）根据InOrOut的值，给窗体上的相关控件赋值，让窗体显示不同的颜色。
4、材料名称复合框CmbName的Change事件代码：
Private Sub CmbName_Change() Dim DicSpec As Object Dim DicUnit As Object Set DicSpec = CreateObject("Scripting.Dictionary") Set DicUnit = CreateObject("Scripting.Dictionary") arrData = ws.Range(Cells(2, 1), Cells(lastRow, lastCol)).Value For i = 2 To iRow If arrData(i, Pxy(TbTitle, "材料名称")) = Me.CmbName Then DicSpec(arrData(i, Pxy(TbTitle, "规格程式"))) = 1 DicUnit(arrData(i, Pxy(TbTitle, "单位"))) = 1 End If Next Me.CmbSpec.Clear Me.CmbSpec.List = DicSpec.keys Me.CmbUnit.Clear Me.CmbUnit.List = DicUnit.keysEnd Sub
代码解析：
（1）把数据读入数组arrData()
（2）把数组中，材料名称=CmbName的记录对应的“规格程式”、“单位”分别装入字典去重，并赋值给相应复合框控件的List。
5、保存按钮代码：
Private Sub CmdSave_Click() Dim rng As Range Set ws = Sheets("材料录入表") ws.Activate lastRow = ws.UsedRange.Rows.Count + 1 Set rng = ws.Range(Cells(lastRow, 1), Cells(lastRow, iCol)) If InOrOut = "入库" Then With ws .Cells(lastRow, Pxy(TbTitle, "出库入库")) = Me.LbType .Cells(lastRow, Pxy(TbTitle, "日期")) = Me.TxbDate .Cells(lastRow, Pxy(TbTitle, "材料名称")) = Me.CmbName .Cells(lastRow, Pxy(TbTitle, "规格程式")) = Me.CmbSpec .Cells(lastRow, Pxy(TbTitle, "单位")) = Me.CmbUnit .Cells(lastRow, Pxy(TbTitle, "数量")) = Me.TxbQuantity .Cells(lastRow, Pxy(TbTitle, "备注")) = Me.TxbMemo With rng .Interior.Color = 49407 .Borders.LineStyle = xlContinuous ' 设置边框线条为实线 .Borders.Color = RGB(0, 0, 0) ' 设置边框颜色为黑色 .Borders.Weight = xlThin ' 设置边框粗细为细 End With End With ElseIf InOrOut = "出库" Then With ws .Cells(lastRow, Pxy(TbTitle, "出库入库")) = Me.LbType .Cells(lastRow, Pxy(TbTitle, "日期")) = Me.TxbDate .Cells(lastRow, Pxy(TbTitle, "材料名称")) = Me.CmbName .Cells(lastRow, Pxy(TbTitle, "规格程式")) = Me.CmbSpec .Cells(lastRow, Pxy(TbTitle, "单位")) = Me.CmbUnit .Cells(lastRow, Pxy(TbTitle, "数量")) = Me.TxbQuantity * (-1) .Cells(lastRow, Pxy(TbTitle, "备注")) = Me.TxbMemo With rng .Interior.Color = 5296274 .Borders.LineStyle = xlContinuous ' 设置边框线条为实线 .Borders.Color = RGB(0, 0, 0) ' 设置边框颜色为黑色 .Borders.Weight = xlThin ' 设置边框粗细为薄 End With End With End If arrData = ws.Range(Cells(2, 1), Cells(lastRow, lastCol)).Value Unload Me UserForm1.Show 0End Sub
代码解析：
（1）把“材料录入表”的最后一个数据行号加1，作为写入目标行。
（2）判断录入类型是出库还是入库，对单元格赋值，并设置不同的背景色，单元格框线。
6、切换按钮代码：
Private Sub CmdSwitch_Click() If InOrOut = "入库" Then InOrOut = "出库" Else InOrOut = "入库" End If Unload Me UserForm1.Show 0End Sub
代码解析：在不直接退出录入窗体的情况下，切换出库、入库录入界面。
7、模块1：自定义函数Pxy
Function Pxy(arr() As Variant, searchValue As Variant) As Long t = LBound(arr) t = 1 - t For i = LBound(arr) To UBound(arr) If arr(i) = searchValue Then Pxy = i + t Exit Function End If Next Pxy = -1 ' 如果未找到值，则返回 -1End Function
代码解析：这个自定义函数我们前面提到过多次了，用来定位字段在一维数组中的位置。
总结
1、通过针对不同按钮，让同一个窗体显示不同内容，实现一个窗体两用、甚至多用。
2、通过表头字段数组，结合自定义定位函数，我们不用去数某个字段是在第几行或第几列，特别是在表头字段特别多的情况下，或者是字段顺序可能会发生变化的情况下，这种方法是非常有用的。
---End---
喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！