ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: 杨炀

求完工产品成本对比表的VBA代码:F-B列都是SUMIFS函数,求相应的VBA代码

[复制链接]

TA的精华主题

TA的得分主题

发表于 2021-6-10 21:35 | 显示全部楼层
52句少一点

TA的精华主题

TA的得分主题

发表于 2021-6-11 08:17 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
杨炀 发表于 2021-6-10 18:45
求完工产品成本对比表的VBA代码:F-B列都是SUMIFS函数,求相应的VBA代码

两处错误,大家都提出来了,
9968.png

TA的精华主题

TA的得分主题

发表于 2021-6-11 08:28 | 显示全部楼层
代码如下,供参考:
  1. Sub 数据汇总()
  2.     Dim arr, i As Long, j As Integer, mStr As String, nStr As String
  3.     Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
  4.     arr = Worksheets("完工产品成本汇总表").UsedRange.Value
  5.     For i = 2 To UBound(arr)
  6.         If Len(arr(i, 1)) > 0 And Val(arr(i, 8)) > 0 Then
  7.             mStr = arr(i, 1)
  8.             If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 8)) Else d(mStr) = d(mStr) + Val(arr(i, 8))
  9.         End If
  10.         If Len(arr(i, 3)) > 0 And Len(arr(i, 4)) > 0 And Len(arr(i, 5)) > 0 And Len(arr(i, 6)) > 0 And Len(arr(i, 7)) > 0 Then
  11.             mStr = arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & ",材料费用," & arr(i, 3)
  12.             If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 10)) Else d(mStr) = d(mStr) + Val(arr(i, 10))
  13.             
  14.             mStr = arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & ",人工费用," & arr(i, 3)
  15.             If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 11)) Else d(mStr) = d(mStr) + Val(arr(i, 11))
  16.             
  17.             mStr = arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & ",费用," & arr(i, 3)
  18.             If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 12)) Else d(mStr) = d(mStr) + Val(arr(i, 12))
  19.             
  20.             mStr = arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & ",计量," & arr(i, 3)
  21.             If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 9)) Else d(mStr) = d(mStr) + Val(arr(i, 9))
  22.         End If
  23.     Next
  24.     Application.ScreenUpdating = False
  25.     With Worksheets("完工产品成本对比表")
  26.         .Activate
  27.         .Range("F3:BM1048576").ClearContents
  28.         arr = .UsedRange.Value
  29.         For i = 3 To UBound(arr)
  30.             If Len(arr(i, 1)) > 0 Then
  31.                 For j = 54 To 65
  32.                     If Len(arr(2, j)) > 0 Then
  33.                         mStr = arr(2, j) & arr(i, 1)
  34.                         If d.Exists(mStr) Then arr(i, j) = d(mStr)
  35.                     End If
  36.                 Next
  37.             End If
  38.             If Len(arr(i, 2)) > 0 And Len(arr(i, 3)) > 0 And Len(arr(i, 4)) > 0 And Len(arr(i, 5)) > 0 Then
  39.                 For j = 6 To 41
  40.                     If Len(arr(2, j)) > 0 Then
  41.                         If Len(arr(1, j)) = 0 Then arr(1, j) = arr(1, j - 1)
  42.                         mStr = arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & "," & arr(1, j) & "," & arr(2, j)
  43.                         nStr = arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & ",计量," & arr(2, j)
  44.                         If d.Exists(mStr) Then arr(i, j) = d(mStr) / d(nStr)
  45.                     End If
  46.                 Next
  47.             End If
  48.             For j = 42 To 53
  49.                 arr(i, j) = Val(arr(i, j - 12)) + Val(arr(i, j - 24)) + Val(arr(i, j - 36))
  50.             Next
  51.         Next
  52.         .UsedRange.Value = arr
  53.     End With
  54.     Application.ScreenUpdating = True
  55.     MsgBox "数据已统计完成!"
  56. End Sub
复制代码


TA的精华主题

TA的得分主题

 楼主| 发表于 2021-6-11 08:51 | 显示全部楼层
opel-wong 发表于 2021-6-10 18:22
把你抄写好代码的附件上传来看看,
你确定没有抄写错?

当出现数量为零时,运算会错误,需要在哪里添加除数为零直接输出零

TA的精华主题

TA的得分主题

发表于 2021-6-11 09:37 | 显示全部楼层
杨炀 发表于 2021-6-11 08:51
当出现数量为零时,运算会错误,需要在哪里添加除数为零直接输出零

嗯,我来修改一下,

TA的精华主题

TA的得分主题

发表于 2021-6-11 09:52 | 显示全部楼层
杨炀 发表于 2021-6-11 08:51
当出现数量为零时,运算会错误,需要在哪里添加除数为零直接输出零

0值的问题修正,同时,代码优化了一下,代码如下(这次不用抄写了,我会发上来,不过论坛审核机制,可能需要等等)
9967.png

TA的精华主题

TA的得分主题

发表于 2021-6-11 09:53 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
代码如下,供参考:
  1. Sub 数据汇总()
  2.     Dim arr, i&, j%, mStr$, nStr$, xR, k%
  3.     Dim d As Object: Set d = CreateObject("Scripting.Dictionary")
  4.     arr = Worksheets("完工产品成本汇总表").UsedRange.Value
  5.     xR = Array(",计量,", ",材料费用,", ",人工费用,", ",费用,")
  6.     For i = 2 To UBound(arr)
  7.         If Len(arr(i, 1)) > 0 And Val(arr(i, 8)) > 0 Then
  8.             mStr = arr(i, 1)
  9.             If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, 8)) Else d(mStr) = d(mStr) + Val(arr(i, 8))
  10.         End If
  11.         If Len(arr(i, 3)) > 0 And Len(arr(i, 4)) > 0 And Len(arr(i, 5)) > 0 And Len(arr(i, 6)) > 0 And Len(arr(i, 7)) > 0 Then
  12.             k = 0
  13.             For j = 0 To UBound(xR)
  14.                 k = j + 9
  15.                 mStr = arr(i, 4) & "," & arr(i, 5) & "," & arr(i, 6) & "," & arr(i, 7) & xR(j) & arr(i, 3)
  16.                 If Not d.Exists(mStr) Then d(mStr) = Val(arr(i, k)) Else d(mStr) = d(mStr) + Val(arr(i, k))
  17.             Next
  18.         End If
  19.     Next
  20.     Application.ScreenUpdating = False
  21.     With Worksheets("完工产品成本对比表")
  22.         .Activate
  23.         .Range("F3:BM1048576").ClearContents
  24.         arr = .UsedRange.Value
  25.         For i = 3 To UBound(arr)
  26.             If Len(arr(i, 1)) > 0 Then
  27.                 For j = 54 To 65
  28.                     If Len(arr(2, j)) > 0 Then
  29.                         mStr = arr(2, j) & arr(i, 1)
  30.                         If d.Exists(mStr) Then arr(i, j) = d(mStr)
  31.                     End If
  32.                 Next
  33.             End If
  34.             If Len(arr(i, 2)) > 0 And Len(arr(i, 3)) > 0 And Len(arr(i, 4)) > 0 And Len(arr(i, 5)) > 0 Then
  35.                 For j = 6 To 41
  36.                     If Len(arr(2, j)) > 0 Then
  37.                         If Len(arr(1, j)) = 0 Then arr(1, j) = arr(1, j - 1)
  38.                         mStr = arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & "," & arr(1, j) & "," & arr(2, j)
  39.                         nStr = arr(i, 2) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 5) & ",计量," & arr(2, j)
  40.                         If d.Exists(mStr) Then
  41.                             If d(mStr) = 0 Or d(nStr) = 0 Then arr(i, j) = 0 Else arr(i, j) = d(mStr) / d(nStr)
  42.                         End If
  43.                     End If
  44.                 Next
  45.             End If
  46.             For j = 42 To 53
  47.                 arr(i, j) = Val(arr(i, j - 12)) + Val(arr(i, j - 24)) + Val(arr(i, j - 36))
  48.             Next
  49.         Next
  50.         .UsedRange.Value = arr
  51.     End With
  52.     Application.ScreenUpdating = True
  53.     MsgBox "数据已统计完成!"
  54. End Sub
复制代码


TA的精华主题

TA的得分主题

 楼主| 发表于 2021-6-11 10:15 | 显示全部楼层
opel-wong 发表于 2021-6-11 09:53
代码如下,供参考:

数值好像对不上,我测算了一下,之前的代码测算的数据是对的。还有不管是除数为零还是被除数为零都是输出是零,因为我测算了还是有些是空的,应该是被除数为零。实在不好意思哈,折腾你那么久。

TA的精华主题

TA的得分主题

发表于 2021-6-11 10:25 | 显示全部楼层
杨炀 发表于 2021-6-11 10:15
数值好像对不上,我测算了一下,之前的代码测算的数据是对的。还有不管是除数为零还是被除数为零都是输出 ...

那你就用13楼的代码吧,

把这里:
If d.Exists(mStr) Then arr(i, j) = d(mStr) / d(nStr)


修改为:
  •                         If d.Exists(mStr) Then
  •                             If d(mStr) = 0 Or d(nStr) = 0 Then arr(i, j) = 0 Else arr(i, j) = d(mStr) / d(nStr)
  •                         End If




您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 22:17 , Processed in 0.048260 second(s), 8 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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