设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

返回列表 发新帖
查看: 195|回复: 3

已解决:满足多条件的求和

[复制链接]

点击这里给我发消息

发表于 2018-1-2 13:36:42 | 显示全部楼层 |阅读模式
本帖最后由 咸中咸 于 2018-1-11 17:28 编辑

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
发表于 2018-1-6 14:51:47 | 显示全部楼层
试下sumifs

点击这里给我发消息

 楼主| 发表于 2018-1-8 17:30:25 | 显示全部楼层

谢谢!

点击这里给我发消息

 楼主| 发表于 2018-1-8 17:31:46 | 显示全部楼层
大神帮忙的,需要可以看哈!
  1. Private Sub CommandButton1_Click()

  2. Application.ScreenUpdating = False

  3. With ThisWorkbook.Worksheets("账目明细")

  4. Dim iArr, lRow As Long
  5. lRow = .Range("C" & Rows.Count).End(xlUp).Row
  6. iArr = .Range("C5:C" & lRow).Value
  7. ReDim iDrr(UBound(iArr), 2)

  8. Dim zD As Object, i As Long: Set zD = CreateObject("Scripting.Dictionary")

  9. For i = 1 To UBound(iArr)
  10.     zD(iArr(i, 1)) = i
  11. Next i

  12. End With

  13. With ThisWorkbook.Worksheets("出入库流水记账簿")

  14. lRow = .Range("C" & Rows.Count).End(xlUp).Row
  15. Erase iArr

  16. iArr = .Range("C5:C" & lRow).Value

  17. Dim iBrr, iCrr
  18. iBrr = .Range("K5:L" & lRow).Value
  19. iCrr = .Range("U5:U" & lRow).Value

  20. End With

  21. With ThisWorkbook.Worksheets("账目明细")

  22. For i = 1 To UBound(iArr)
  23.     If zD.Exists(iArr(i, 1)) Then
  24.         If iBrr(i, 1) < iBrr(i, 2) Or Date - iCrr(i, 1) < 15 Then
  25.             iDrr(zD(iArr(i, 1)), 1) = iDrr(zD(iArr(i, 1)), 1) + iBrr(i, 1)
  26.         ElseIf iBrr(i, 1) = iBrr(i, 2) Or Date - iCrr(i, 1) > 15 Then
  27.             iDrr(zD(iArr(i, 1)), 2) = iDrr(zD(iArr(i, 1)), 2) + iBrr(i, 1)
  28.         End If
  29.     End If
  30. Next i

  31. Set zD = Nothing
  32. .[H5].Resize(UBound(iDrr), 2).Value = iDrr

  33. End With

  34. Application.ScreenUpdating = True
  35. End Sub
复制代码
您需要登录后才可以回帖 登录 | 注册

本版积分规则

关闭

站长推荐上一条 /6 下一条

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2018-7-19 02:19 , Processed in 0.097055 second(s), 31 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表