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

H10086 · 发表于 2009-12-27 14:37

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

非常感谢

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

LangQueS · 发表于 2009-12-27 15:12

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

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

zhaogang1960 · 发表于 2009-12-27 15:18

是不是少了一个出库明细表，加上了一个请测试：

出入库表.rar (12.46 KB, 下载次数: 89)

H10086 · 发表于 2009-12-27 15:36

谢谢你们指点

vbe001 · 发表于 2009-12-27 16:09

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

zhaogang1960 · 发表于 2009-12-27 16:44

原帖由 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 · 发表于 2018-8-5 22:43

字典我要看看

		自动登录	找回密码
密码			免费注册

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

谢谢