用VBA合并计算

chnjoe

里面是自己写的，也能用，但是感觉不好，来论坛看看高手们的思路。

今日123

看见这么多数组有点发麻。建议用这样的定义来写
Option Base 1

Sub 计算外购件和安全库存需求()

Dim arr(3), Key(3), T(3), d(3)
Dim brr, crr, drr, i, j, k, n
For i = 1 To UBound(d) '三个字典
    Set d(i) = CreateObject("scripting.dictionary")
Next i
放点数据好来验证下代码有没有写错。讲下汇总关系

End Sub

xunanming

按你代码的逻辑进行的重写,代码在moudel1.请参考.

zxsea_7426

今日123 发表于 2023-3-11 00:09
看见这么多数组有点发麻。建议用这样的定义来写
Option Base 1

看得确实有点头皮发麻，还不如一项一项来做，非要搞得一起整，像我这样的老电脑内存不够的还不一定能顺畅运行起来。

zxsea_7426

可以copy 一个副本，看一下结果是否正确，因为没有数据难证，只能看代码猜楼主的意思表达

1. Sub 计算外购件和安全库存需求___()
   
2.     Dim arr1 As Variant, arr2 As Variant, arr3 As Variant, arr4 As Variant  'Rem arr1明细表数组，arr2库存数组，arr3出库数组
   
3.     Dim brr As Variant
   
4.     Dim i As Integer
   
5.     '============================================================================================A
   
6.     arr1 = Sheet1.Range("a2：t" & Sheet1.UsedRange.Rows.Count)  'Rem 赋值外购件明细表到数组
   
7.     arr2 = Sheet2.Range("a2:f" & Sheet2.UsedRange.Rows.Count)   'Rem 赋值库存明细到数组
   
8.     arr3 = Sheet3.Range("a2:f" & Sheet3.UsedRange.Rows.Count)   'Rem 赋值出库明细到数组
   
9.     Set d = CreateObject("scripting.dictionary")
   
10.     For i = 1 To UBound(arr2)       '库存明细字典
    
11.         d(arr2(i, 2) & "库存") = d(arr2(i, 2) & "库存") + arr2(i, 6)        '存货编码
    
12.     Next
    
13.     For i = 1 To UBound(arr3)       '出库明细字典
    
14.         d(arr3(i, 1) & arr3(i, 2) & "出库") = d(arr3(i, 1) & arr3(i, 2)) + arr3(i, 6) '项目编号+物料编号
    
15.     Next
    
16.     ReDim brr(1 To UBound(arr1), 1 To 3)        '原代码一个工作表两次输出合并为一次输出
    
17.     For i = 1 To UBound(arr1)
    
18.         If d.exists(arr1(i, 4) & "库存") Then
    
19.             brr(i, 3) = d(arr1(i, 4))
    
20.         End If
    
21.         If d.exists(arr1(i, 2) & arr1(i, 4) & "出库") Then
    
22.             brr(i, 2) = d(arr1(i, 2) & arr1(i, 4) & "出库")
    
23.         End If
    
24.         If arr1(i, 17) = "" Then d(arr1(i, 4) & "总需求") = d(arr1(i, 4) & "总需求") + arr1(i, 11) - arr1(i, 13)
    
25.     Next i
    
26.     '==========总需求循环一次才能有需求数据，所以需要二次循环得出结果
    
27.     For i = 1 To UBound(arr1)
    
28.         If d.exists(arr1(i, 4) & "总需求") Then brr(i, 1) = d(arr1(i, 4) & "总需求")
    
29.     Next i
    
30.     '-------------------------------------------------------------
    
31.     Sheet1.Range("l2").Resize(UBound(arr1), 3) = brr
    
32.     '----------------------------------------------------A结束---------------------------------------------------
    
33.     '数组可以使用上面任意一个数组重新赋值而形成，因为上面的数组已经使用结束，同时也可以清除上而三个数组以释放内在占用,
    
34.     Erase arr1: Erase arr2: Erase arr3  '清除三个数组
    
35.     '============================================================================================================
    
36.     arr1 = Sheet4.Range("a2:n" & Sheet4.UsedRange.Rows.Count)           'arr1再次投入使用
    
37.     For i = 1 To UBound(arr1)
    
38.         If d.exists(arr1(i, 2) & "库存") Then  '物料编码   存货
    
39.             arr1(i, 8) = d(arr1(i, 2) & "库存")
    
40.         End If
    
41.         If d.exists(arr1(i, 2) & "总需求") Then  '物料编码   需求
    
42.             arr1(i, 9) = d(arr1(i, 2) & "总需求")
    
43.         End If
    
44.     Next i
    
45.     '=========================不加新数组，使用更新数组两次独列输出===================
    
46.     Sheet4.Range("h2").Resize(UBound(arr1), 1) = WorksheetFunction.Index(arr1, 0, 8)
    
47.     Sheet4.Range("i2").Resize(UBound(arr1), 1) = WorksheetFunction.Index(arr1, 0, 9)
    
48. End Sub
    

复制代码

zxsea_7426

xunanming 发表于 2023-3-11 03:00
按你代码的逻辑进行的重写,代码在moudel1.请参考.

你这一段两次循环

为啥不合并成一次循环

xunanming

zxsea_7426 发表于 2023-3-11 08:43
你这一段两次循环

为啥不合并成一次循环

可以的,当时只一步步输出数据了,就没有注意合并,谢谢你提醒.

chnjoe

zxsea_7426 发表于 2023-3-11 08:28
可以copy 一个副本，看一下结果是否正确，因为没有数据难证，只能看代码猜楼主的意思表达

感谢，提供了很多技巧和思路，不知道看的对不对，在算总需求减出库直接用的ARR1里面的数据，不是按出库明细计算的数据，这样结果不对吧。

zxsea_7426

chnjoe 发表于 2023-3-11 12:28
感谢，提供了很多技巧和思路，不知道看的对不对，在算总需求减出库直接用的ARR1里面的数据，不是按出库明 ...

这是你的原始代码，我加了几行注释，


没有看出来是输出更新后的数据再计算的。

chnjoe

zxsea_7426 发表于 2023-3-11 15:43
这是你的原始代码，我加了几行注释，

之前字典用的不熟练，用了太多的数组，学到了一些改了下。好看多了。