求助按条件取值求和的问题，谢谢

lsc900707

zhycl 发表于 2018-6-19 18:43
非常抱歉，老师，您再给改改吧，受累了

有时间我再改改。

lsc900707

zhycl 发表于 2018-6-19 18:43
非常抱歉，老师，您再给改改吧，受累了

修改好了，代码多一层遍历而已。附件仅供测试参考：

zhycl

lsc900707 发表于 2018-6-20 00:38
修改好了，代码多一层遍历而已。附件仅供测试参考：

首先非常感谢老师帮助，我想调整一下取数规则，老师您受累再给看看吧，非常感谢  详见附件内如注释说明：Sheet1表源数据有多行，在Sheet2表中根据规则将Sheet1表中的数据进行提炼，Sheet2表中金额合计不能每次运行都累加上次的结果。
           一个“单号”中存在多个“单位”，但只有一个“开票单位”。
           将一个“单号”中，每个“单位”对应的“项目编码”合并到Sheet2表中的D列，金额求和到E列。

希望老师能给予帮助，非常感谢！！！ 示例.rar (20.07 KB, 下载次数: 5)

2018-6-20 11:46 上传

点击文件名下载附件

zhycl

lsc900707 发表于 2018-6-20 00:38
修改好了，代码多一层遍历而已。附件仅供测试参考：

老师，您给予的代码，每点一次运行，它会自动累加上次的，能让它 不 累加上一次的吗？

lsc900707

zhycl 发表于 2018-6-21 20:57
老师，您给予的代码，每点一次运行，它会自动累加上次的，能让它 不 累加上一次的吗？

先清空就好了：

1. Sub gj23w98()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     For i = 1 To UBound(arr)
   
5.         d(arr(i, 1)) = arr(i, 2)
   
6.     Next
   
7.     r = Cells(Rows.Count, 4).End(3).Row
   
8.     Range("e1:e" & r) = ""
   
9.     brr = Range("d1:e" & r)
   
10.     For i = 1 To UBound(brr)
    
11.         crr = Split(brr(i, 1), ",")
    
12.         For j = 0 To UBound(crr)
    
13.             brr(i, 2) = brr(i, 2) + d(Val(crr(j)))
    
14.         Next
    
15.     Next
    
16.     Range("d1:e" & r) = brr
    
17. End Sub

复制代码

zhycl

lsc900707 发表于 2018-6-21 21:05
先清空就好了：

老师，我想把J到Y列求和放到Z列，我写了如下代码，但提示错误，能给指点一下吗？
Sub 项目付款明细()
Dim nRow, arr, i, j, brr, sm
Application.ScreenUpdating = False

With Sheets("项目付款明细")
  nRow = .Range("a" & .Rows.Count).End(3).Row
  arr = .Range("j6:y" & nRow)
  brr = .Range("z6:z" & nRow)
End With

  For i = 1 To UBound(arr)
     sm = 0
     For j = 1 To 16
       sm = arr(i, j) + sm
     Next j
     brr(i, 17) = sm
  Next i

Sheets("项目付款明细").Range("z6:z" & nRow) = brr

Application.ScreenUpdating = True

End Sub

lsc900707

zhycl 发表于 2018-7-17 17:23
老师，我想把J到Y列求和放到Z列，我写了如下代码，但提示错误，能给指点一下吗？
Sub 项目付款明细()
D ...

你把出错的文件上传一下看看。