Office中国论坛/Access中国论坛

标题: 已解决：满足多条件的求和 [打印本页]

---

作者: 咸中咸    时间: 2018-1-2 13:36
标题: 已解决：满足多条件的求和


我自己根据需要做的一个出入库流水账，里面包含有现有库存时时报表、产品送试、报废等等，但是最后在生成报表的时候，库存统计的时候有一个地方不会，有劳各位大神弄一个VBA程序，谢谢！
计算方式：                                                   
1、只有当“账目明细”的材料代码等于“出入库流水记账簿”时，对应的有：“账目明细”可用=“出入库流水记账簿”里相同材料代码的库存之和，纳入求和的条件是：“出入库流水记账簿”次材料代码的库存小于入库数量或者是今天日期减去送检日期小于15.
2、只有当“账目明细”的材料代码等于“出入库流水记账簿”时，对应的有：“账目明细”待验=“出入库流水记账簿”里相同材料代码的库存之和，纳入求和的条件是：“出入库流水记账簿”次材料代码的库存等于入库数量或者是今天日期减去送检日期大于15.

---

作者: roych    时间: 2018-1-6 14:51
试下sumifs

---

作者: 咸中咸    时间: 2018-1-8 17:30

roych 发表于 2018-1-6 14:51
试下sumifs

谢谢！

---

作者: 咸中咸    时间: 2018-1-8 17:31
大神帮忙的，需要可以看哈！

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Application.ScreenUpdating = False
   
4. 
   
5. With ThisWorkbook.Worksheets("账目明细")
   
6. 
   
7. Dim iArr, lRow As Long
   
8. lRow = .Range("C" & Rows.Count).End(xlUp).Row
   
9. iArr = .Range("C5:C" & lRow).Value
   
10. ReDim iDrr(UBound(iArr), 2)
    
11. 
    
12. Dim zD As Object, i As Long: Set zD = CreateObject("Scripting.Dictionary")
    
13. 
    
14. For i = 1 To UBound(iArr)
    
15.     zD(iArr(i, 1)) = i
    
16. Next i
    
17. 
    
18. End With
    
19. 
    
20. With ThisWorkbook.Worksheets("出入库流水记账簿")
    
21. 
    
22. lRow = .Range("C" & Rows.Count).End(xlUp).Row
    
23. Erase iArr
    
24. 
    
25. iArr = .Range("C5:C" & lRow).Value
    
26. 
    
27. Dim iBrr, iCrr
    
28. iBrr = .Range("K5:L" & lRow).Value
    
29. iCrr = .Range("U5:U" & lRow).Value
    
30. 
    
31. End With
    
32. 
    
33. With ThisWorkbook.Worksheets("账目明细")
    
34. 
    
35. For i = 1 To UBound(iArr)
    
36.     If zD.Exists(iArr(i, 1)) Then
    
37.         If iBrr(i, 1) < iBrr(i, 2) Or Date - iCrr(i, 1) < 15 Then
    
38.             iDrr(zD(iArr(i, 1)), 1) = iDrr(zD(iArr(i, 1)), 1) + iBrr(i, 1)
    
39.         ElseIf iBrr(i, 1) = iBrr(i, 2) Or Date - iCrr(i, 1) > 15 Then
    
40.             iDrr(zD(iArr(i, 1)), 2) = iDrr(zD(iArr(i, 1)), 2) + iBrr(i, 1)
    
41.         End If
    
42.     End If
    
43. Next i
    
44. 
    
45. Set zD = Nothing
    
46. .[H5].Resize(UBound(iDrr), 2).Value = iDrr
    
47. 
    
48. End With
    
49. 
    
50. Application.ScreenUpdating = True
    
51. End Sub
    

复制代码

---

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)

Powered by Discuz! X3.3