求老师帮忙写个SUMIF函数的VBA自动更新总档库存

yysfcq1

ykcbf1100 发表于 2024-6-16 19:34
参与一下。。。

老师你这个是对的，缺点就是有点慢了

quqiyuan

参与一下。。

wang-way

yysfcq1 发表于 2024-6-16 19:50
老师你这个结果不对

改一句就可以了  你的物料清单的B列能不能改 ？

lushang2018

试一试，试一试

ykcbf1100

yysfcq1 发表于 2024-6-16 19:54
老师你这个是对的，缺点就是有点慢了

结果正确才是最重要的。

wang-way

1. Rem 过程开始 X改为你想要的名字
   
2. Public Sub X()
   
3.     Rem 代码从这里开始写
   
4.     Rem 设置wb为当前工作簿
   
5.     Rem 创建一个字典dic
   
6.     Set dic = CreateObject("Scripting.Dictionary")
   
7.     Set wb = Application.ThisWorkbook
   
8.     Rem 设置sht为指定名称的工作表，引号内填写工作表名称
   
9.     Set sht = wb.Worksheets("物料清单")
   
10.     Rem 使用With语句，方便对工作表Sht进行多次操作
    
11.     With sht
    
12.         '.Usedrange.Offset(1).clear
    
13.         Rem 获取列A中最大数据行的行号
    
14.         eRow = .Cells(.Rows.count, 1).End(xlUp).Row
    
15.         Rem 设置范围从A2开始到Z列的eRow行结束
    
16.         Set rng = .Range("B2:B" & eRow)
    
17.         Rem 将范围Rng的值赋给数组Arr
    
18.         arr = rng.Value
    
19.         Rem 变量 i 从数组Arr最小索引开始，遍历至其最大索引
    
20.         For i = LBound(arr) To UBound(arr)
    
21.             Key = CStr(arr(i, 1))
    
22.             dic(Key) = 0
    
23.         Next i
    
24.     End With
    
25.                                                             
    
26.                                                             
    
27.                                                             
    
28.     Rem 设置osht为工作表，在引号内填写工作表名称
    
29.     Set oSht = wb.Worksheets("总档")
    
30.     With oSht
    
31.         Rem 获取列A中最大数据行的行号
    
32.         eRow = .Cells(.Rows.count, 2).End(xlUp).Row
    
33.         Rem 设置范围为A2单元格
    
34.         Set rng = .Range("A3:H" & eRow)
    
35.         Rem 将范围Rng的值赋给数组Arr
    
36.         arr = rng.Value
    
37.         Rem 变量 i 从数组Arr最小索引开始，遍历至其最大索引
    
38.         For i = LBound(arr) To UBound(arr)
    
39.             Key = CStr(arr(i, 2))
    
40.             dic(Key) = dic(Key) + arr(i, 8)
    
41.         Next i
    
42.     End With
    
43.     Rem 使用With语句，方便对工作表Sht进行多次操作
    
44.     With sht
    
45.         '.Usedrange.Offset(1).clear
    
46.         Rem 获取列A中最大数据行的行号
    
47.         eRow = .Cells(.Rows.count, 2).End(xlUp).Row
    
48.         Rem 设置范围从A2开始到Z列的eRow行结束
    
49.         Set rng = .Range("A2:A" & eRow)
    
50.         Rem 如果字典有元素，则将字典的项目转置后输出到指定范围Rng
    
51.         Rem 如果字典有元素，则将字典的项目转置后输出到指定范围Rng
    
52.         If dic.count > 0 Then rng.Value = WorksheetFunction.Transpose(dic.items)
    
53.     End With
    
54.                                                    
    
55. End Sub
    
56. Rem 过程结束
    

复制代码

wang-way

ykcbf1100 发表于 2024-6-16 20:04
结果正确才是最重要的。

提前读取key 输出就快一点而已

ykcbf1100

wang-way 发表于 2024-6-16 20:15
提前读取key 输出就快一点而已

嗯，应该是吧。

macrov

公式速度慢，是因为sumif()的第二个参数不合理，A列填充的公式很多都是多余的，没有根据需要填充。公式也是瞬间完成，并不比VBA慢