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

yysfcq1

把物料清单A列的SUMIF函数用VBA来写，函数太卡了

ykcbf1100

没看明白。

yysfcq1

ykcbf1100 发表于 2024-6-16 19:13
没看明白。

老师你好，就是把物料清单A列的SUMIF函数用VBA来写，函数太卡了。

wang-way

yysfcq1 发表于 2024-6-16 19:17
老师你好，就是把物料清单A列的SUMIF函数用VBA来写，函数太卡了。

你确定是A列 数据也没有 叫别人怎么猜？

yysfcq1

wang-way 发表于 2024-6-16 19:23
你确定是A列 数据也没有 叫别人怎么猜？

老师你好，物料清单A列有公式，我想把公式换成VBA这样会快很多。

ykcbf1100

yysfcq1 发表于 2024-6-16 19:17
老师你好，就是把物料清单A列的SUMIF函数用VBA来写，函数太卡了。

明白了，附件供参考。

wang-way

1. Rem 过程开始 X改为你想要的名字
   
2. Public Sub X()
   
3.     Rem 代码从这里开始写
   
4.     Rem 声明工作簿变量wb和工作表变量sht
   
5.     Dim wb As Workbook, sht As Worksheet
   
6.     Rem 声明工作表对象变量oSht
   
7.     Dim oSht As Worksheet
   
8.     Rem 设置wb为当前工作簿
   
9.     Set wb = Application.ThisWorkbook
   
10.     Rem 设置sht为指定名称的工作表，引号内填写工作表名称
    
11.     Set sht = wb.Worksheets("总档")
    
12.     Rem 设置osht为工作表，在引号内填写工作表名称
    
13.     Set oSht = wb.Worksheets("物料清单")
    
14.                         
    
15.     Rem 创建一个字典dic
    
16.     Set dic = CreateObject("Scripting.Dictionary")
    
17.                         
    
18.                                     
    
19.     Rem 使用With语句，方便对工作表Sht进行多次操作
    
20.     With sht
    
21.         '.Usedrange.Offset(1).clear
    
22.         Rem 获取列A中最大数据行的行号
    
23.         eRow = .Cells(.Rows.count, 2).End(xlUp).Row
    
24.         For i = 3 To eRow Step 1
    
25.             Key = .Cells(i, 2).Value
    
26.             Item = .Cells(i, 8).Value
    
27.             dic(Key) = dic(Key) + Item
    
28.         Next
    
29.     End With
    
30.                     
    
31.     With oSht
    
32.         Rem 设置范围为A2单元格
    
33.         Set rng = .Range("A2")
    
34.         Rem 调整范围Rng的大小，行数为字典键值对数量dic.Count，列数为2
    
35.         Set rng = rng.Resize(dic.count, 1)
    
36.                
    
37.         Rem 如果字典有元素，则将字典的项目转置后输出到指定范围Rng
    
38.         rng.Value = WorksheetFunction.Transpose(dic.items)
    
39.                                 
    
40.     End With
    
41. 
    
42. End Sub
    
43. Rem 过程结束
    

复制代码

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.6.16
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("总档")
   
6.         r = .Cells(Rows.count, "b").End(xlUp).Row
   
7.         arr = .[a1].Resize(r, 8)
   
8.     End With
   
9.     For i = 3 To UBound(arr)
   
10.         s = arr(i, 2)
    
11.         d(s) = d(s) + arr(i, 8)
    
12.     Next
    
13.     With Sheets("物料清单")
    
14.         r = .Cells(.Rows.count, "b").End(xlUp).Row
    
15.         arr = .[a1].Resize(r, 2)
    
16.         For i = 2 To UBound(arr)
    
17.             s = arr(i, 2)
    
18.             If d.Exists(s) Then
    
19.                 arr(i, 1) = d(s)
    
20.             End If
    
21.         Next
    
22.         .[a1].Resize(r, 2) = arr
    
23.     End With
    
24.     Set d = Nothing
    
25.     Application.ScreenUpdating = True
    
26.     MsgBox "OK！"
    
27. End Sub
    
28. 
    

复制代码

yysfcq1

wang-way 发表于 2024-6-16 19:34

老师你这个结果不对

lushang2018

1. Sub 测试()
   
2.     Dim i%, arr
   
3.     Dim dic As Object, key
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     arr = Sheet1.Range("B2:H" & Sheet1.Cells(Rows.count, "B").End(xlUp).Row)
   
6.     For i = 2 To UBound(arr)
   
7.         key = arr(i, 1)
   
8.         dic(key) = dic(key) + arr(i, 8)
   
9.     Next
   
10.     Sheet4.Activate
    
11.     For i = 2 To Sheet4.Cells(Rows.count, "B").End(xlUp).Row
    
12.         key = Sheet4.Cells(i, 2)
    
13.         Sheet4.Cells(i, 1) = dic(key)
    
14.     Next
    
15. End Sub

复制代码