VBA 库存管理：自动更新库存表数据

这是一段 VBA 代码，用于更新库存表数据。代码中使用了字典对象存储库存数据，使用数组存储入库明细单和出库明细单数据。遍历入库明细单和出库明细单数组，更新字典中的库存量。然后将字典中的数据填充到库存表数组中，再将数组写入到库存表中。最后使用函数填充其他列的数据，如商品编码、单位、单价、金额等，并格式化数字列，自动调整列宽，取消其他选区的高亮显示。

Sub 求库存()
    Dim dic As Object
    Dim arr As Variant
    Dim brr As Variant
    Dim k As Variant
    Dim s As String
    Dim ss As Variant
    Dim i As Long
    Dim n As Long
    
    '使用字典对象存储库存数据
    Set dic = CreateObject("scripting.dictionary")
    
    '使用数组存储入库明细单数据
    With Sheets("入库明细单")
        arr = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 6).Value
    End With
    
    '遍历入库明细单数组，更新字典中的库存量
    For i = 2 To UBound(arr)
        s = arr(i, 1) '商品编码
        dic(s) = dic(s) + arr(i, 6) '进货数量
    Next
    
    '使用数组存储出库明细单数据
    With Sheets("出库明细单")
        arr = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 6).Value
    End With
    
    '遍历出库明细单数组，更新字典中的库存量
    For i = 2 To UBound(arr)
        s = arr(i, 1) '商品编码
        dic(s) = dic(s) - arr(i, 6) '销售数量
    Next
    
    '使用数组存储库存表数据
    ReDim brr(1 To dic.Count, 1 To 7)
    
    '获取字典中的键值对
    k = dic.keys
    
    '遍历字典中的键值对，填充库存表数组
    For i = 1 To dic.Count
        s = k(i - 1) '商品编码
        If dic(s) <> 0 Then '如果库存量不为零，则写入数组
            n = n + 1 '记录有效行数
            ss = Split(s, "_") '分割商品编码，获取商品名称和规格型号
            brr(n, 1) = ss(0) '商品名称
            brr(n, 4) = ss(1) '规格型号
            brr(n, 6) = dic(s) '库存量
        End If
        
    Next
    
    '清空原有的库存表数据
    Sheets("库存表").Range("2:65536").ClearContents
    
    '将数组写入到库存表中
    Sheets("库存表").Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr

    '使用函数填充其他列的数据，如商品编码、单位、单价、金额等
    With Sheets("库存表")
        .Range("B2:B" & n + 1).FormulaR1C1 = "=GetCode(RC[-1],RC[2])"
        .Range("C2:C" & n + 1).FormulaR1C1 = "=GetUnit(RC[-2])"
        .Range("D2:D" & n + 1).FormulaR1C1 = "=GetPrice(RC[-3])"
        .Range("E2:E" & n + 1).FormulaR1C1 = "=RC[-3]*RC[-1]"
        .Range("G2:G" & n + 1).FormulaR1C1 = "=GetRemark(RC[-6])"
        
        '将公式转换为值，避免计算负担和错误提示
        .Range("B2:G" & n + 1).Value = .Range("B2:G" & n + 1).Value
        
        '格式化数字列，如单价、金额等
        .Range("D2:E" & n + 1).NumberFormatLocal = "￥#,##0.00"
        
        '自动调整列宽，使数据显示完整美观
        .Columns.AutoFit
        
        '选中第一个单元格，取消其他选区的高亮显示
        .Range("A2").Select
        
    End With

End Sub

'定义一个函数，根据商品名称和规格型号获取商品编码
Function GetCode(name As String, spec As String) As String

    Dim ws As Worksheet
    
    Set ws = Sheets("编码表")
    
    GetCode = Application.VLookup(name & "_" & spec, ws.Range("A:C"), 3, False)
    
End Function

'定义一个函数，根据商品名称获取单位
Function GetUnit(name As String) As String

    Dim ws As Worksheet
    
    Set ws = Sheets("编码表")
    
    GetUnit = Application.VLookup(name, ws.Range("A:D"), 4, False)
    
End Function

'定义一个函数，根据商品名称获取单价
Function GetPrice(name As String) As String

    Dim ws As Worksheet
    
    Set ws = Sheets("编码表")
    
    GetPrice = Application.VLookup(name, ws.Range("A:E"), 5, False)
    
End Function

'定义一个函数，根据商品名称获取备注信息（可选）
Function GetRemark(name As String) As String

   Dim ws As Worksheet
   
   Set ws = Sheets("编码表")
   
   GetRemark = Application.VLookup(name, ws.Range("A:F"), 6, False)
   
End Function

该代码实现的功能：

从入库明细单和出库明细单中读取数据，更新库存字典中的数量。
将库存字典中的数据写入库存表数组。
将数组写入到库存表中。
使用函数填充商品编码、单位、单价、金额等信息。
格式化数字列，自动调整列宽，取消其他选区的高亮显示。

该代码可以帮助您自动更新库存表，提高库存管理效率。您可以根据实际情况调整代码中使用的表名、列名和函数，以适应您的具体需求。