累加叠加求和

Peny2020

不知道能不能实现这个功能。谢谢各位大神。
还有个要求，就是如果发现在DATA表格里没有此序号的，则在最后一行新增一条数据。谢谢。

盼盼198310

..................

Peny2020

盼盼198310 发表于 2023-6-9 14:19
..................

盼盼大神你好，因为我是英语系统所以不可以有中文，我就把表头改为NO，然后代码跟着改了，但结果不是加到原来的数据里而是放到了最后.
然后可否加个if，就是当序号不在总表里的就新增到最后一行里。谢谢，麻烦你了。

sdytsxd991122

ericxzhou

1. Sub test()
   
2.     Dim i%, arr, d, d1
   
3.     arr = Sheets("Original").[a1].CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set d1 = CreateObject("scripting.dictionary")
   
6.     For i = 2 To UBound(arr)
   
7.         d(arr(i, 13)) = d(arr(i, 13)) + arr(i, 16)
   
8.         d1(arr(i, 13)) = d1(arr(i, 13)) + arr(i, 20)
   
9.     Next
   
10.     arr = Sheets("Data").[a1].CurrentRegion
    
11.     For i = 2 To UBound(arr)
    
12.         If d.exists(arr(i, 1)) Then
    
13.             arr(i, 2) = arr(i, 2) + d(arr(i, 1))
    
14.             arr(i, 3) = arr(i, 3) + d1(arr(i, 1))
    
15.             arr(i, 4) = arr(i, 3) / arr(i, 2)
    
16.         End If
    
17.     Next
    
18.     Sheets("Data").[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
19. End Sub

复制代码

盼盼198310

Peny2020 发表于 2023-6-9 14:43
盼盼大神你好，因为我是英语系统所以不可以有中文，我就把表头改为NO，然后代码跟着改了，但结果不是加 ...

目前的代码就是你要的效果,如果运行不对的话,就把data表的空白行全部选中删除试试

盼盼198310

Peny2020 发表于 2023-6-9 14:43
盼盼大神你好，因为我是英语系统所以不可以有中文，我就把表头改为NO，然后代码跟着改了，但结果不是加 ...

where [no] 替换原来的 where no

Peny2020

盼盼198310 发表于 2023-6-9 15:19
where [no] 替换原来的 where no

太好了，原来是要加个[]，谢谢盼盼大神

盼盼198310

Peny2020 发表于 2023-6-9 15:21
太好了，原来是要加个[]，谢谢盼盼大神

完善了一下试试

Peny2020

盼盼198310 发表于 2023-6-9 15:25
完善了一下试试

盼盼大神，请问如果我要在E 列加个日期，就是只要此行写入数据就录入日期在这一列里，真是不好意思麻烦到你了。