求仓库自动出入库（帮帮我！！！）

H10086

各位老师，帮我一下，有附件。


          非常感谢




                  在线等！！！！！！！！！！！！！！！

LangQueS

★Excel数据管理的一般规律★        http://club.excelhome.net/thread-287461-1-1.html

★利用单元颜色动态判断记录方式★        http://club.excelhome.net/viewth ... e%3D1&frombbs=1

zhaogang1960

是不是少了一个出库明细表，加上了一个请测试：
出入库表.rar (12.46 KB, 下载次数: 89)

2009-12-27 15:18 上传

点击文件名下载附件

H10086

谢谢你们指点

vbe001

三楼的朋友，能不能注释下你的代码呢，正在学习中

zhaogang1960

原帖由 vbe001 于 2009-12-27 16:09 发表
三楼的朋友，能不能注释下你的代码呢，正在学习中

3代码原理基本相同，注释第一个：
Private Sub Worksheet_Activate()
    Dim arr, brr(), d As Object
    Dim temp$, i&, j%, m%
    arr = Sheets("入库明细表").Range("A1").CurrentRegion '入库明细表数据区域写入数组
    Set d = CreateObject("scripting.dictionary") '创建数据字典对象
    ReDim brr(1 To UBound(arr), 1 To 4) '重新定义动态数组brr
    For i = 2 To UBound(arr) '逐行
        temp = arr(i, 2) & arr(i, 4) '连接名称和价格
        If Not d.Exists(temp) Then '如果名称和价格字符串字典不存在
            m = m + 1 '行号+1
            d(temp) = m '名称和价格字符串添加到字典键值，行号添加到字典条目
            For j = 2 To 5 '逐列
                brr(m, j - 1) = arr(i, j) '全部写入brr
            Next
        Else '如果名称和价格字符串字典已经存在
            brr(d(temp), 2) = brr(d(temp), 2) + arr(i, 3) '数量和总额累加
            brr(d(temp), 4) = brr(d(temp), 2) + arr(i, 5)
        End If
    Next
    Range("A2").CurrentRegion.Offset(2, 0).ClearContents '清除原数据
    Range("A3").Resize(m, 4) = brr '写数据
End Sub

ledou87

字典我要看看