Excel VBA 出入库明细表/数据录入窗体

快速浏览

往期合集：【2023年3月】【2023年4月】【2023年5月】【2023年6月】【2023年7月】

实用案例

|收费管理系统|中医诊所收费系统|

|日期控件|简单的收发存|

|电子发票管理助手|Excel表格拆分神器|

|Excel多种类型文件合并||电子发票登记系统（Access版）|

收费使用项目

|财务管理系统|

内容提要

• 用户窗体录入数据

大家好，我是冷水泡茶，今天在论坛上看到一个求助贴：

他的明细表是这样的：

当然，今天我不是要说怎么满足他的需求，而是我看到这个明细表，我想到录入这个明细表可能是一件比较费功夫的事，可以利用窗体来录入数据，增加录入的速度、提高数据的准确性。说干就干，经过一番操作，搞定录入数据的问题，其他的功能暂时先放一边。

我们一起来看一看吧（文末有视频演示）。

基本思路

1、设置一个用户窗体，在上面放上“材料录入表”表头字段对应的文本框或复合框控件，供填写或选择录入数据。

2、把“材料录入表”数据读入数组，以备提取“材料名称”、“规格程式”、“单位”等数据，供录入时选择，如果是新的项目，则手工输入，在下次录入时即可选取。

3、点“保存”按钮，把数据写入“材料录入表”。

程序代码

1、在“首页“添加”入库“、“出库”命令按钮：

2、“入库”、“出库”按钮代码：

Private Sub CmdMaterialIn_Click()    InOrOut = "入库"    UserForm1.Show 0End Sub
Private 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---

喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！

需要示例文件的朋友请稍微留意一下：

• 写文不易，分享免费，请关注、点赞、点在看、点广告、留言，如果不愿走上面的“流程”，您可以直接打赏，万分感谢！