[已解决]请求修改代码（因单元格变化，原代码不能使用）

蝶·舞 · 发表于 2014-5-3 19:53

因为工作需要用到进销存，搜索到以前一个进销存，跟我的需要有点差不多，但还是存在些格式上差异，从而格式更改后导致代码运行出错，希望各大高手能帮忙一下。

新建文件夹.zip (494.36 KB, 下载次数: 11)

Zipall · 发表于 2014-5-3 20:09

同一编码的商品,入库单价是否一定相同? 如果不同,汇总表的单价填什么?(first? last? average?) 出库单价同理.

btw 你上传的两个文件里都没有代码.

蝶·舞 · 发表于 2014-5-3 20:35

Zipall 发表于 2014-5-3 20:09
同一编码的商品,入库单价是否一定相同? 如果不同,汇总表的单价填什么?(first? last? average?) 出库单价同理 ...

不好意思，一不小心把原始代码都删除掉了

Sub 宏1()
Dim arr, brr(), d As Object, i&, j&, t
Set d = CreateObject("scripting.dictionary")
arr = Sheets("基础资料").[a1].CurrentRegion
ReDim brr(2 To UBound(arr), 2 To 18)
For i = 2 To UBound(arr)
d(arr(i, 2)) = i
For j = 2 To 7
brr(i, j) = arr(i, j)
Next
brr(i, 9) = arr(i, 8)
Next
arr = Sheets("出入库明细").[a1].CurrentRegion
For i = 2 To UBound(arr)
t = d(arr(i, 4))
If t <> "" Then
If arr(i, 2) <> "出库" Then
brr(t, 10) = brr(t, 10) + arr(i, 9)
brr(t, 12) = brr(t, 12) + arr(i, 11)
Else
brr(t, 13) = brr(t, 13) + arr(i, 9)
brr(t, 15) = brr(t, 15) + arr(i, 11)
End If
End If
Next
For i = 2 To UBound(brr)
If Len(brr(i, 10)) Then brr(i, 11) = brr(i, 12) / brr(i, 10)
If brr(i, 10) + brr(i, 7) > 0 Then brr(i, 14) = (brr(i, 12) + brr(i, 9)) / (brr(i, 10) + brr(i, 7))
If brr(i, 7) + brr(i, 10) - brr(i, 13) > 0 Then brr(i, 16) = brr(i, 7) + brr(i, 10) - brr(i, 13)
If brr(i, 9) + brr(i, 12) - brr(i, 15) > 0 Then brr(i, 18) = brr(i, 9) + brr(i, 12) - brr(i, 15)
If Len(brr(i, 16)) Then brr(i, 17) = brr(i, 18) / brr(i, 16)
Next
ActiveSheet.UsedRange.Offset(7).ClearContents
[b8].Resize(d.Count, 17) = brr
End Sub

复制代码

Zipall · 发表于 2014-5-3 22:29

请求修改代码2.rar (157.65 KB, 下载次数: 22)

蝶·舞 · 发表于 2014-5-4 09:27

Zipall 发表于 2014-5-3 22:29

多谢了，比我以前用笨方式速度快了好几倍

蝶·舞 · 发表于 2014-5-4 09:39

Zipall 发表于 2014-5-3 22:29

不好意思，再追加问一下，因为这个代码是将基础资料表中的所有品名进行汇总，我现在能不能要求汇总查询里的所列示的品名进行查询，因为品名编码有分类的（1字头，2字头），如果我选择1字头，就汇总1字头的，而不需要将2字头，3字头的信息列示并汇总出来

Zipall · 发表于 2014-5-4 13:39

蝶·舞发表于 2014-5-4 09:39
不好意思，再追加问一下，因为这个代码是将基础资料表中的所有品名进行汇总，我现在能不能要求汇总查询里 ...

可以在汇总完成后根据某个单元格中的关键字进行自动筛选.
自动筛选的代码你可以先试试用录制宏的方法得到.

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